r语言 - Shiny:仅在选择某些输入时显示操作按钮

Question

我有一个闪亮的应用程序与多个选项卡。在其中一个选项卡上，我在base 1和base 2之间有一个选项。选择base 1会导致一个带有许多不同选项的复选框组，而base 2会导致一个简单的选择输入，您可以在其中选择只有两个选项中的一个。

当选择base 1时，我添加了select all和deselect all按钮(以动作链接的形式)。我想只在选择base 1时显示这些按钮。我的第一反应是将两个操作链接放入与checkboxgroup相同的renderUI中，但是随后用于更新checkboxgroup输入的observe函数无法识别操作链接id并崩溃。

所以我想也许我可以简单地隐藏他们，当他们不需要使用shinyjs，但这似乎也不起作用。下面是我的示例代码(我选择包含两个选项卡，因为我可以在网上找到的所有答案都不适合我，并且由只有一个选项卡存在的问题组成)。

library(shiny)
library(shinydashboard)
library(shinyjs)

UI:

ui <- dashboardPage(
dashboardHeader(title = "First Past Yield"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = "tab1", icon = icon("stats",lib = "glyphicon")),
menuItem("Tab 2", tabName = "tab2", icon = icon("dashboard",lib = "glyphicon"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
fluidRow(
column(width = 4,
box(title = "Inputs",width = NULL,status = 'primary',solidHeader = TRUE,
checkboxGroupInput("some_input",h3("Some Input"),choices = list("Input 1" = 1,"Input 2" = 2,"Input 3" = 3),
selected = c(1,2),inline = TRUE))),
column(width = 8,
box(title = "Outputs",width = NULL,status = "primary", solidHeader = TRUE, "Some Output")))),
tabItem(tabName = "tab2",
fluidRow(
column(width = 4,
box(title = "Inputs",width = NULL,status = 'primary',solidHeader = TRUE,
selectInput("base",h3("Basis"),choices = list("Base 1" = 1,"Base 2" = 2),selected = 1),
uiOutput("basestuff"),
actionLink("selectall","Select All"),
actionLink("selectnone",HTML(paste('&emsp;',"Deselect All")))
)),
column(width = 8,
box(title = "Outputs",width = NULL,status = "primary", solidHeader = TRUE, "Some Output")))))))

服务器:

server <- function(input,output,session){

output$basestuff <- renderUI({
if(input$base == 1){
checkboxGroupInput("many_choices",h3("Many Choices"),choices = list("a" = 1,"b" = 2,"c" = 3,"d" = 4,"e" = 5, "f" = 6, "g" = 7),
selected = 1:7,inline = TRUE)
}
else if(input$base == 2){
selectInput("few_choices",h3("Few Choices"),choices = list("a" = 1,"b" = 2),selected = 1)
}
})

observe({
shinyjs::toggle(id = "selectall",condition = input$base == 1)
})

observe({
shinyjs::toggle(id = "selectnone",condition = input$base == 1)
})

observe({
if(input$selectall == 0) return(NULL)
else if (input$selectall > 0){
updateCheckboxGroupInput(session,"many_choices",choices = list("a" = 1,"b" = 2,"c" = 3,"d" = 4,"e" = 5, "f" = 6, "g" = 7),
selected = 1:7,inline = TRUE)}
})

observe({
if(input$selectnone == 0) return(NULL)
else if (input$selectnone > 0){
updateCheckboxGroupInput(session,"many_choices",choices = list("a" = 1,"b" = 2,"c" = 3,"d" = 4,"e" = 5, "f" = 6, "g" = 7),inline = TRUE)
}
})
}

shinyApp(ui = ui, server = server)

Answer 1

添加这个而不是两个toggle:并且不要忘记将useShinyjs(),放到dashboardBody

library(shiny)
library(shinydashboard)
library(shinyjs)

ui <- dashboardPage(
dashboardHeader(title = "First Past Yield"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = "tab1", icon = icon("stats",lib = "glyphicon")),
menuItem("Tab 2", tabName = "tab2", icon = icon("dashboard",lib = "glyphicon"))
)
),
dashboardBody(
useShinyjs(),
tabItems(
tabItem(tabName = "tab1",
fluidRow(
column(width = 4,
box(title = "Inputs",width = NULL,status = 'primary',solidHeader = TRUE,
checkboxGroupInput("some_input",h3("Some Input"),choices = list("Input 1" = 1,"Input 2" = 2,"Input 3" = 3),
selected = c(1,2),inline = TRUE))),
column(width = 8,
box(title = "Outputs",width = NULL,status = "primary", solidHeader = TRUE, "Some Output")))),
tabItem(tabName = "tab2",
fluidRow(
column(width = 4,
box(title = "Inputs",width = NULL,status = 'primary',solidHeader = TRUE,
selectInput("base",h3("Basis"),choices = list("Base 1" = 1,"Base 2" = 2),selected = 1),
uiOutput("basestuff"),
actionLink("selectall","Select All"),
actionLink("selectnone",HTML(paste('&emsp;',"Deselect All")))
)),
column(width = 8,
box(title = "Outputs",width = NULL,status = "primary", solidHeader = TRUE, "Some Output")))))))
server <- function(input, output, session) {


output$basestuff <- renderUI({
if(input$base == 1){
checkboxGroupInput("many_choices",h3("Many Choices"),choices = list("a" = 1,"b" = 2,"c" = 3,"d" = 4,"e" = 5, "f" = 6, "g" = 7),
selected = 1:7,inline = TRUE)
}
else if(input$base == 2){
selectInput("few_choices",h3("Few Choices"),choices = list("a" = 1,"b" = 2),selected = 1)
}
})

observeEvent(input$base,{
if(input$base == 1){
shinyjs::show("selectall")
shinyjs::show("selectnone")
}else{
shinyjs::hide("selectall")
shinyjs::hide("selectnone")
}
})


observe({
if(input$selectall == 0) return(NULL)
else if (input$selectall > 0){
updateCheckboxGroupInput(session,"many_choices",choices = list("a" = 1,"b" = 2,"c" = 3,"d" = 4,"e" = 5, "f" = 6, "g" = 7),
selected = 1:7,inline = TRUE)}
})

observe({
if(input$selectnone == 0) return(NULL)
else if (input$selectnone > 0){
updateCheckboxGroupInput(session,"many_choices",choices = list("a" = 1,"b" = 2,"c" = 3,"d" = 4,"e" = 5, "f" = 6, "g" = 7),inline = TRUE)
}
})
}
shinyApp(ui, server)