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

Question

我需要创建一个Shiny App，它将为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")
    )
  )
))

谢谢！

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)

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