在为每个用户提供 2 个不同版本的闪亮小部件的应用程序中,特定用户可能能够设置其他用户的闪亮小部件的选择

In an app with 2 different versions of shiny widget for each user speicic user may be able to set the choices of shiny widget of the other user

我有下面这个闪亮的应用程序,其中有 2 个用户 shiny(admin) 和 shinymanager。根据用户可能使用的凭据,他会看到不同的 selectInput()“变量”。

我想做的是让 shiny 用户能够设置 shinymanager 将在他的“变量”中看到的值 selectInput() 和“选择” selectInput().

# define some credentials
credentials <- data.frame(
  user = c("shiny", "shinymanager"), # mandatory
  password = c("azerty", "12345"), # mandatory
  start = c("2019-04-15"), # optinal (all others)
  expire = c(NA, NA),
  admin = c(FALSE, TRUE),
  comment = "Simple and secure authentification mechanism
  for single ‘Shiny’ applications.",
  stringsAsFactors = FALSE
)

library(shiny)
library(shinymanager)

ui <- fluidPage(
  tags$h2("My secure application"),
  uiOutput("myinput"),
  uiOutput("chs"),
  actionButton("action_logout", "Logout")
  
)

# Wrap your UI with secure_app
ui <- secure_app(ui)


server <- function(input, output, session) {
  observeEvent(input$action_logout, {
    session$reload()
  })
  # call the server part
  # check_credentials returns a function to authenticate users
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  output$chs<-renderUI({
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      selectInput("ch",
                  "Choices:",
                  choices = c("Cylinders" = "cyl",
                              "Transmission" = "am",
                              "Gears" = "gear"),selected="cyl,multiple = T)
    }
    else{
      
    }
      
  })
  output$myinput <- renderUI({
    
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      # if (TRUE) {
      mychoices <- c("Cylinders" = "cyl",
                     "Transmission" = "am",
                     "Gears" = "gear")
    } else {
      mychoices <- input$ch
    }
    
    selectInput("variable",
                "Variable:",
                choices = mychoices)
  })
  
  
  
}

shinyApp(ui, server)

我们需要以某种方式保存 shiny 用户所做的选择,但是您需要考虑应该将选择保存到哪个时间点。在下面的示例中,我只是在每次 input$choices 更改时保存选项。我只是使用 saveRDSreadRDS 将其保存在应用程序的工作目录中,但您可以使用子文件夹或数据库或您可能拥有的任何其他选项。

您还需要考虑,shinymanager 如果到目前为止没有保存任何选择,您会看到什么 - 我在下面的方法中忽略了这一点。

# define some credentials
credentials <- data.frame(
  user = c("shiny", "shinymanager"), # mandatory
  password = c("azerty", "12345"), # mandatory
  start = c("2019-04-15"), # optinal (all others)
  expire = c(NA, NA),
  admin = c(FALSE, TRUE),
  comment = "Simple and secure authentification mechanism
  for single ‘Shiny’ applications.",
  stringsAsFactors = FALSE
)

library(shiny)
library(shinymanager)

ui <- fluidPage(
  tags$h2("My secure application"),
  uiOutput("myinput"),
  uiOutput("chs"),
  actionButton("action_logout", "Logout")
  
)

# Wrap your UI with secure_app
ui <- secure_app(ui)

server <- function(input, output, session) {
  
  # call the server part
  # check_credentials returns a function to authenticate users
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  
  observeEvent(input$action_logout, {
    session$reload()
  })
  
  observeEvent(input$choices, {
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      print("Lets save")
      print(getwd())
      saveRDS(input$choices, file = "save_choices.rds")
    }
  })
  
  output$chs <- renderUI({
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      selectInput("choices",
                  "Choices:",
                  choices = c("Cylinders" = "cyl",
                              "Transmission" = "am",
                              "Gears" = "gear"),
                  multiple = TRUE)
    }
  })
  
  output$myinput <- renderUI({
    
    if (reactiveValuesToList(res_auth)$user == "shiny") {
      
      mychoices <- c("Cylinders" = "cyl",
                     "Transmission" = "am",
                     "Gears" = "gear")
    } else if (file.exists("save_choices.RDS")) {
      
      mychoices <- readRDS(file = "save_choices.rds")
      
    } else {
      
      mychoices <- NULL
      
    } 
  
  selectInput("variable",
              "Variable:",
              choices = mychoices)
  })
  
}

shinyApp(ui, server)