Как создать разные информационные панели для разных пользователей приложения Shiny? (в том же коде приложения)
Мне нужно создать приложение Shiny, которое будет генерировать 6 разных версий одного и того же макета панели инструментов для 6 разных пользователей. Каждый пользователь увидит свои собственные исторические данные во время производства, и все они находятся в одной базе данных (я предполагаю, что мне просто нужно отфильтровать всю базу данных для каждого конкретного пользователя).
Конкретно:
1 - Как определить, кто какой пользователь? Я собираюсь использовать аутентификацию, поэтому я предполагаю, что смогу получить информацию от пользователя по тому, как он вошел в систему. Но как мне получить эту информацию в терминах кода?
2 - Зная, кто какой пользователь, как мне создать 6 разных версий одного и того же кода приложения? У них будет один и тот же макет, единственное отличие — фильтрация набора данных на основе пользователя.
(необязательно) 3 - Как серверы Shiny согласовывают дисплеи разных пользователей? Думаете о приборной панели, которая взаимодействует с пользователем, и разные входы не мешают отображениям друг друга? Должны ли они копировать код для каждого доступа, чтобы они были независимыми результатами?
Я еще не сделал это, и даже если бы я сделал, я думаю, что это было бы слишком сложно, чтобы решить здесь, поэтому я публикую Hello World of Shiny. Таким образом, представьте, что набор данных, используемый для построения гистограммы, имеет столбец с именем «пользователь». Какой код будет использоваться для дискриминации пользователей?
library(shiny)
output$distPlot <- renderPlot({
dist <- dataset[1:obs,1] %>% filter(???)
hist(dist)
})
})
shinyUI(fluidPage(
titlePanel("Hello Shiny!"),
# Sidebar with a slider input for number of observations
sidebarLayout(
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 1,
max = 1000,
value = 500)
),
mainPanel(
plotOutput("distPlot")
)
)
))
Спасибо!
Ответы 2
login1 <- c("user1", "pw1")
login2 <- c("user2", "pw2")
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
uiOutput("ui")
# Sidebar with a slider input for number of bins
)
# Define server logic required to draw a histogram
server <- function(input, output) {
logged <- reactiveValues(logged = FALSE, user = NULL)
observeEvent(input$signin, {
if (input$name == "user1" & input$pw == "pw1") {
logged$logged <- TRUE
logged$user <- "user1"
} else if (input$name == "user2" & input$pw == "pw2") {
logged$logged <- TRUE
logged$user <- "user2"
} else {}
})
output$ui <- renderUI({
if (logged$logged == FALSE) {
return(
tagList(
textInput("name", "Name"),
passwordInput("pw", "Password"),
actionButton("signin", "Sign In")
)
)
} else if (logged$logged == TRUE & logged$user == "user1") {
return(
tagList(
titlePanel("This is user 1 Panel"),
tags$h1("User 1 is only able to see text, but no plots")
)
)
} else if (logged$logged == TRUE & logged$user == "user2") {
return(
tagList(
titlePanel("This is user 2 Panel for Executetives"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
)
} else {}
})
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Это ПРОСТОЙ способ заставить его работать. Вы получаете reactiveValues в качестве условных входных данных для функции renderUI.
Однако это очень опасное решение, так как пароли и пользователи не шифруются. Для профессионального развертывания с R Shiny подумайте о Shiny-Server или моем любимом ShinyProxy (https://www.shinyproxy.io/).
Если вы используете аутентификацию, предоставленную в Shinyapps.io, вот простое решение для отображения разных элементов пользовательского интерфейса для разных пользователей.
library(shiny)
library(dplyr)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
# Sidebar with a slider input for number of observations
sidebarLayout(
sidebarPanel(
uiOutput("slider")
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
# If using shinyapps.io the users email is stored in session$user
#session$user = "testuser1"
# session$user = "testuser2"
session$user = "testuser3"
slider_max_limit <- switch(session$user,
"testuser1" = 100,
"testuser2" = 200,
"testuser3" = 500)
output$slider <- renderUI(sliderInput("hp",
"Filter Horsepower:",
min = min(mtcars$hp),
max = slider_max_limit,
value = 70))
output$distPlot <- renderPlot({
req(input$hp)
mtcars %>%
filter(hp < input$hp) %>%
.$mpg %>%
hist(.)
})
}
shinyApp(ui, server)
Раскомментировав разных пользователей в функции сервера, вы увидите, как меняется ползунок.
Спасибо вам, ребята! Это должно сделать