闪亮的应用程序checkboxInput和conditionalPanel

好的,您可以将条件输入分为两类.

1)依赖于ui.R的输入(在您的情况下为checkboxInput)

2)依赖于server.R的输入(在您的示例中不必要)

解决方案:

1)您可以使用renderUI()函数轻松解决,请参阅下面的示例.

如果你真的想要2),你需要一个conditionalPanel,你将在server.R中使用一个被动函数,你将它保存在一个输出对象中并使用ui.R中的小JS-snippet访问它.对我来说,它看起来像1)对你来说已经足够了,如果我弄错了,请让我知道然后我们调整答案来解决2).

一个提示:

默认情况下,"checkbox"输入采用布尔值:false.所以你不会渲染"typeInput"(直到你点击"复选框").所以直到那一点"typeInput"为空.但是,如果你现在依赖于"typeInput"闪亮会被混淆,因为"typeInput"不会被渲染,因此不存在.所以在使用"typeInput"之前,你应该检查它是否可用: if(!is.null(input$typeInput))否则有光泽会抱怨你的应用中实际上没有"typeinput"(再次:至少在你点击"复选框"之前).

ui <- fluidPage(
  titlePanel("BC Liquor Store prices"),
  img(src = "BCLS.png",align = "right"),
  sidebarLayout(
    sidebarPanel(sliderInput("priceInput", "Price", 0, 100, c(25, 40), pre = "$"),

                 wellPanel(
                   checkboxInput("checkbox", "Filter by Type", FALSE),
                   uiOutput("conditionalInput")
                 ),

                 uiOutput("countryOutput")

    ),
    mainPanel(
      tabsetPanel(
        tabPanel("Plot", plotOutput("coolplot")), 
        tabPanel("Summary", verbatimTextOutput("summary")), 
        tabPanel("Table", tableOutput("results"))
      )
    )
  )
)

server <- function(input, output, session) {
  output$countryOutput <- renderUI({
    selectInput("countryInput", "Country",
                sort(unique(bcl$Country)),
                selected = "CANADA")
  })  

  output$conditionalInput <- renderUI({
    if(input$checkbox){
      selectInput("typeInput", "Product type",
                  choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"),
                  selected = "WINE")
    }
  })

  filtered <- reactive({
    if (is.null(input$countryInput)) {
      return(NULL)
    }    

    bcl %>%
      filter(Price >= input$priceInput[1],
             Price <= input$priceInput[2],
             Type == input$typeInput,
             Country == input$countryInput
      )
  })

  output$coolplot <- renderPlot({
    if (is.null(filtered())) {
      return()
    }
    filtered() %>% ggvis(~Alcohol_Content, fill := "#fff8dc") %>% 
      layer_histograms(width = 1, center = 0)
  })

  output$results <- renderTable({
    filtered()
  })
}

# run the app
shinyApp(ui = ui, server = server)