在为每个用户提供 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
更改时保存选项。我只是使用 saveRDS
和 readRDS
将其保存在应用程序的工作目录中,但您可以使用子文件夹或数据库或您可能拥有的任何其他选项。
您还需要考虑,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)
我有下面这个闪亮的应用程序,其中有 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
更改时保存选项。我只是使用 saveRDS
和 readRDS
将其保存在应用程序的工作目录中,但您可以使用子文件夹或数据库或您可能拥有的任何其他选项。
您还需要考虑,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)