如何按条件隐藏多个闪亮的ui，以及如何使用session$userData？
How to hide multiple shiny ui by condition, and how to use session$userData?
我是shiny新手，正在用win10系统，rstudio，shiny 1.7.1版本搭建一个shiny应用。我想让它更面向用户。这意味着除非用户上传正确的数据，否则应用程序的其他部分将被隐藏。经过多次尝试，我决定使用session$userData和shinyjs::toggle来开发这个应用程序。但是我对session$userData感到困惑。刚开始看了official documentation，觉得跟r的全局环境差不多。但显然不是。所以我只想知道如何正确使用它，或者如何实现我想要的功能。我试过三个例子，供大家参考。
请注意，第三个示例几乎是我想要的，但我认为它不够优雅，因为继续按钮有点多余。
示例 1：
我想检查是否有数据输入或输入数据是否为csv格式，如果是，则显示数据，如果没有，应用程序的其余部分将被隐藏。在这种情况下你可以看到，虽然你的数据通过了校验，但是tablepanel b仍然不会显示任何内容，除非你在输入数据之前点击了tablepanel b，或者除非在数据校验之后你再次点击了按钮。
##### 1. packages #####
library(shiny)
library(shinyjs)
##### 2. ui #####
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T),
)
})
output$p1m_datacheck <- renderPrint({
# data check part, the result of checking is stored by session$userData$sig
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
observe({
toggle(id = "ui_p2_sidebar", condition = session$userData$sig)
toggle(id = "ui_p2_main", condition = session$userData$sig)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
示例 2：
在这个小案例中你可以看到，在一个sample模块中，session$userData$...及时改变了，但是在另一个模块中，它不会改变，除非你再次点击按钮。这意味着 session$userData$... 可以同时具有不同的值？
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
sidebarLayout(
sidebarPanel(uiOutput("ui_sidebar")),
mainPanel(uiOutput("ui_main1"), uiOutput("ui_main2"))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_sidebar <- renderUI({
tagList(
radioButtons("s_letter", "letters", choices = c("a", "b", "c")),
shiny::actionButton(inputId = "go1",
label = "GO1",
icon = icon("play"))
)
})
observeEvent(input$go1, {
output$ui_main1 <- renderUI({
tagList(
h3("module 1: shared value changes timely."),
verbatimTextOutput(outputId = "m1", placeholder = T),
h3("module 2: shared value changes by button."),
verbatimTextOutput(outputId = "m2", placeholder = T)
)
})
output$m1 <- renderPrint({
out <- switch (input$s_letter,
"a" = "choose a",
"b" = "choose b",
"c" = "choose c")
session$userData$sharedout <- out
cat("out: \n")
print(out)
cat("sharedout: \n")
print(session$userData$sharedout)
})
output$m2 <- renderPrint({
cat("sharedout: \n")
print(session$userData$sharedout)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
示例 3： 我也尝试了其他解决方案。有一个例子1的修改，我添加了一个继续按钮来实现我的想法。它运作良好，但我希望隐藏的动作是基于条件而不是事件。那么如何在数据校验通过后去掉按钮让其余部分自动显示呢？
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
uiOutput("ispass"),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
)
})
output$p1m_datacheck <- renderPrint({
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$ispass <- renderUI({
if(isFALSE(session$userData$sig)){
return()
} else{
shiny::actionButton(inputId = "ispass",
label = "continue",
icon = icon("play"))
}
})
})
observeEvent(input$ispass,{
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
我希望下面的重构会有所帮助，并做你想做的。
隐藏、显示和更新 UI 元素的基本工具可以是 renderUI，但由于重新渲染，这通常是矫枉过正的。
但我建议使用 shinyjs-package，它为您提供 shinyjs::show 和 shinyjs::hide 等用于显示和隐藏的功能。为了更新 UI 个元素，有像 shiny::updateActionButton,shiny::updateCheckboxInput, shiny::updateRadioButtons, ... 这样的函数。
为您的 UI 元素提供 ID（例如 tabsetPanel）（总是）有用。
此外，shiny::conditionalPanel 也是一个不错的工具，但在编写更多应用程序时，您将深入研究所有这些内容。 :)
##### 1. packages #####
library(shiny)
myapp <- function() {
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(
fileInput(inputId = "p1s_inputdata", label = "Input data", multiple = FALSE, accept = ".csv")
),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(radioButtons("aaa", "aaa", choices = c("some", "placeholder", "stuff"))),
mainPanel(verbatimTextOutput(outputId = "p2m_print", placeholder = T))
)),
id = "TABSETPANEL"
)
)
##### 3. server #####
server <- function(input, output, session) {
shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
observeEvent(input$p1s_inputdata, {
data <- input$p1s_inputdata
dataCheckText <- NULL
if(is.null(data)){
dataCheckText <- "There is no data input!"
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
dataCheckText <- "Please input csv data!"
session$userData$sig <- F
} else{
dataCheckText <- "Data have passed the check!"
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
output$p1m_datacheck <- renderPrint(dataCheckText)
if(session$userData$sig) shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
else shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
main1Taglist <- tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T)
)
if(session$userData$sig) {
shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
output$p1m_datashow <- renderPrint({
print(session$userData$data)
})
main1Taglist <- c(main1Taglist, tagList(
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
))
#Update stuff in panel b according to the new data
updateRadioButtons(session = session, inputId = "aaa", choices = names(session$userData$data))
output$p2m_print <- renderPrint({print(letters[1:10])})
}
output$ui_p1_main <- renderUI(main1Taglist)
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
}
myapp()
您在某种程度上是在正确的轨道上。尝试这样的事情：
observeEvent(input$go1, {
# Perform data validation here.
# This would look similar to what you have inside output$p1m_datacheck <- renderPrint({})
# If data file is no good, do nothing, exit this function: return()
# Else, data file is good, continue
# Do your output$* <- render*() functions here
})
您不需要在 observeEvent() 的 handlerExpr 中 isolate()。它已经在 isolate() 范围内执行。
我是shiny新手，正在用win10系统，rstudio，shiny 1.7.1版本搭建一个shiny应用。我想让它更面向用户。这意味着除非用户上传正确的数据，否则应用程序的其他部分将被隐藏。经过多次尝试，我决定使用session$userData和shinyjs::toggle来开发这个应用程序。但是我对session$userData感到困惑。刚开始看了official documentation，觉得跟r的全局环境差不多。但显然不是。所以我只想知道如何正确使用它，或者如何实现我想要的功能。我试过三个例子，供大家参考。
请注意，第三个示例几乎是我想要的，但我认为它不够优雅，因为继续按钮有点多余。
示例 1： 我想检查是否有数据输入或输入数据是否为csv格式，如果是，则显示数据，如果没有，应用程序的其余部分将被隐藏。在这种情况下你可以看到，虽然你的数据通过了校验，但是tablepanel b仍然不会显示任何内容，除非你在输入数据之前点击了tablepanel b，或者除非在数据校验之后你再次点击了按钮。
##### 1. packages #####
library(shiny)
library(shinyjs)
##### 2. ui #####
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T),
)
})
output$p1m_datacheck <- renderPrint({
# data check part, the result of checking is stored by session$userData$sig
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
observe({
toggle(id = "ui_p2_sidebar", condition = session$userData$sig)
toggle(id = "ui_p2_main", condition = session$userData$sig)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
示例 2：
在这个小案例中你可以看到，在一个sample模块中，session$userData$...及时改变了，但是在另一个模块中，它不会改变，除非你再次点击按钮。这意味着 session$userData$... 可以同时具有不同的值？
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
sidebarLayout(
sidebarPanel(uiOutput("ui_sidebar")),
mainPanel(uiOutput("ui_main1"), uiOutput("ui_main2"))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_sidebar <- renderUI({
tagList(
radioButtons("s_letter", "letters", choices = c("a", "b", "c")),
shiny::actionButton(inputId = "go1",
label = "GO1",
icon = icon("play"))
)
})
observeEvent(input$go1, {
output$ui_main1 <- renderUI({
tagList(
h3("module 1: shared value changes timely."),
verbatimTextOutput(outputId = "m1", placeholder = T),
h3("module 2: shared value changes by button."),
verbatimTextOutput(outputId = "m2", placeholder = T)
)
})
output$m1 <- renderPrint({
out <- switch (input$s_letter,
"a" = "choose a",
"b" = "choose b",
"c" = "choose c")
session$userData$sharedout <- out
cat("out: \n")
print(out)
cat("sharedout: \n")
print(session$userData$sharedout)
})
output$m2 <- renderPrint({
cat("sharedout: \n")
print(session$userData$sharedout)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
示例 3： 我也尝试了其他解决方案。有一个例子1的修改，我添加了一个继续按钮来实现我的想法。它运作良好，但我希望隐藏的动作是基于条件而不是事件。那么如何在数据校验通过后去掉按钮让其余部分自动显示呢？
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
uiOutput("ispass"),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
)
})
output$p1m_datacheck <- renderPrint({
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$ispass <- renderUI({
if(isFALSE(session$userData$sig)){
return()
} else{
shiny::actionButton(inputId = "ispass",
label = "continue",
icon = icon("play"))
}
})
})
observeEvent(input$ispass,{
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
我希望下面的重构会有所帮助，并做你想做的。
隐藏、显示和更新 UI 元素的基本工具可以是 renderUI，但由于重新渲染，这通常是矫枉过正的。
但我建议使用 shinyjs-package，它为您提供 shinyjs::show 和 shinyjs::hide 等用于显示和隐藏的功能。为了更新 UI 个元素，有像 shiny::updateActionButton,shiny::updateCheckboxInput, shiny::updateRadioButtons, ... 这样的函数。
为您的 UI 元素提供 ID（例如 tabsetPanel）（总是）有用。
此外，shiny::conditionalPanel 也是一个不错的工具，但在编写更多应用程序时，您将深入研究所有这些内容。 :)
##### 1. packages #####
library(shiny)
myapp <- function() {
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(
fileInput(inputId = "p1s_inputdata", label = "Input data", multiple = FALSE, accept = ".csv")
),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(radioButtons("aaa", "aaa", choices = c("some", "placeholder", "stuff"))),
mainPanel(verbatimTextOutput(outputId = "p2m_print", placeholder = T))
)),
id = "TABSETPANEL"
)
)
##### 3. server #####
server <- function(input, output, session) {
shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
observeEvent(input$p1s_inputdata, {
data <- input$p1s_inputdata
dataCheckText <- NULL
if(is.null(data)){
dataCheckText <- "There is no data input!"
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
dataCheckText <- "Please input csv data!"
session$userData$sig <- F
} else{
dataCheckText <- "Data have passed the check!"
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
output$p1m_datacheck <- renderPrint(dataCheckText)
if(session$userData$sig) shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
else shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
main1Taglist <- tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T)
)
if(session$userData$sig) {
shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
output$p1m_datashow <- renderPrint({
print(session$userData$data)
})
main1Taglist <- c(main1Taglist, tagList(
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
))
#Update stuff in panel b according to the new data
updateRadioButtons(session = session, inputId = "aaa", choices = names(session$userData$data))
output$p2m_print <- renderPrint({print(letters[1:10])})
}
output$ui_p1_main <- renderUI(main1Taglist)
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
}
myapp()
您在某种程度上是在正确的轨道上。尝试这样的事情：
observeEvent(input$go1, {
# Perform data validation here.
# This would look similar to what you have inside output$p1m_datacheck <- renderPrint({})
# If data file is no good, do nothing, exit this function: return()
# Else, data file is good, continue
# Do your output$* <- render*() functions here
})
您不需要在 observeEvent() 的 handlerExpr 中 isolate()。它已经在 isolate() 范围内执行。