如何为 Shiny 应用的不同用户创建不同的仪表板？ （在相同的应用程序代码上）

Question

我需要创建一个闪亮的应用程序，它将为 6 个不同的用户生成相同仪表板布局的 6 个不同版本。每个用户在生产过程中都会看到自己的历史数据，并且都在同一个数据库中（我猜我只需要为每个特定用户过滤整个数据库）。

具体来说：

1 - 我如何检测哪个用户是哪个？我将使用身份验证，所以我猜我可能可以通过他的登录方式从用户那里检索信息。但是如何以代码形式检索这些信息？

2 - 知道哪个用户是哪个用户，我如何在同一个应用代码上创建 6 个不同的版本？它们将是相同的布局，唯一的区别是基于用户的数据集过滤。

（可选） 3 - Shiny 服务器如何协调不同用户的显示？考虑具有用户交互的仪表板，不同的输入不会干扰彼此的显示？他们是否必须为每次访问复制代码以便它们成为独立的结果？

我还没有做到，即使我做到了，我认为这里解决起来太复杂了，所以我发布了闪亮的 Hello World。这样，假设用于绘制直方图的数据集有一个名为“用户”的列。用于区分用户的代码是什么？

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")
    )
  )
))

谢谢！

Answer 1

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/)

Answer 2

如果您使用的是 shinyapps.io 中提供的身份验证，这里有一个简单的解决方案，可以向不同的用户显示不同的 UI 元素。

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)

通过取消注释服务器功能中的不同用户，您可以看到滑块的变化。