根据条件在 R shiny 中显示/隐藏 selectinput

Question

我正在尝试使用条件来显示或隐藏 R shiny 应用程序中的选择输入，具体取决于选项卡是否在 UI 中可用。因此，在标题为 product use 的选项卡面板上，应该可以看到产品类别下的所有下拉菜单，否则只有产品类别下的第一个下拉菜单应该可见。

以下是我正在做的但没有使条件起作用：

# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
library(shiny)
library(shinydashboard)
library(shinyBS)
library(knitr)
library(kableExtra)
library(shiny)
library(shinythemes)


ui <- dashboardPage(
  dashboardHeader(disable = F, title = "PATH Study"),
  dashboardSidebar(
    selectInput(
      "wave",
      h4("Wave"),
      choices = list(
        "Wave 1" = 1
      ),
      selected = 1
    ),
    sidebarMenu(
      menuItem(
        "Population Filter",
        selectInput(
          "ethnicity",
          h4("Ethnicity"),
          choices = list(
            "Hispanic" = 1,
            "Asian" = 2,
            "White" = 3,
            "African American" = 4
          ),
          selected = 1
        ),
        selectInput(
          "age",
          h4("Age Group"),
          choices = list(
            "Total" = 1,
            "Youth(12-17)" = 2,
            "Young Adult (18-24)" = 3,
            "Adult (25+)" = 4
          ),
          selected = 1
        ),
        selectInput(
          "category",
          h4("Gender"),
          choices = list(
            "Total" = 1,
            "Male" = 2,
            "Female" = 3
          ),
          selected = 1
        )
      )
    ),
    conditionalPanel(
      condition = "dashboardBody(tabPanel(title  == 'product_use'))",
      sidebarMenu(menuItem(
        "Product Category",
        selectInput(
          "category",
          h4("Category"),
          choices = list(
            "Total Cigars" = 1,
            "Cigarillo" = 2,
            "Cigarette" = 3,
            "E-Vapor" = 4
          ),
          selected = 1
        ),
        selectInput(
          "flavor",
          h4("Flavor"),
          choices = list(
            "Total" = 1,
            "Flavored" = 2,
            "Non-Flavored" = 3
          ),
          selected = 1
        ),
        selectInput(
          "use_level",
          h4("User Level"),
          choices = list(
            "Total" = 1,
            "Experimental" = 2,
            "Established" = 3,
            "No Tobacco Use" = 4
          ),
          selected = 1
        )
      ))
    )
    
    
  ),
  #S dashboardPage(header = dashboardHeader(), sidebar = dashboardSidebar(),body,title = NUll, skin = "yellow"),
  dashboardBody(box(
    width = 12,
    tabBox(
      width = 12,
      id = "tabBox_next_previous",
      tabPanel("Initiation",
               fluidRow(
                 box(
                   title = "Wave 1 Ever Tried and % 1st Product Flavored",
                   width = 5,
                   solidHeader = TRUE,
                   status = "primary",
                   tableOutput("smoke"),
                   collapsible = F,
                   bsTooltip(
                     "bins",
                     "The wait times will be broken into this many equally spaced bins",
                     "right",
                     options = list(container = "body")
                   )
                 )
                     )),

      tabPanel("Cessation", p("This is tab 3")),
      tabPanel("product_use", p("This is tab 4")),
      tags$script(
        "
        $('body').mouseover(function() {
        list_tabs=[];
        $('#tabBox_next_previous li a').each(function(){
        list_tabs.push($(this).html())
        });
        Shiny.onInputChange('List_of_tab', list_tabs);})
        "
      )
    ),
    
    uiOutput("Next_Previous")
  ))
)


server <- function(input, output, session) {
  output$Next_Previous = renderUI({
    tab_list = input$List_of_tab[-length(input$List_of_tab)]
    nb_tab = length(tab_list)
    if (which(tab_list == input$tabBox_next_previous) == nb_tab)
      column(1, offset = 1, Previous_Button)
    else if (which(tab_list == input$tabBox_next_previous) == 1)
      column(1, offset = 10, Next_Button)
    else
      div(column(1, offset = 1, Previous_Button),
          column(1, offset = 8, Next_Button))
    
  })
  
  output$smoke <-
    
    #   renderTable({
    #   pct_ever_user(data_selector(wave = 1, youth = FALSE), type = "SM")
    # })
    
    function() {
      pct_ever_user(data_selector(wave = 1, youth = FALSE), type = "SM")[, c("variable", "mean", "sum_wts", "se")] %>%
        # rename(pct_ever_user(data_selector(wave = 1, youth = FALSE), type = "SM"), c("mean"="N", "sum_wts"="Weighted N"))%>%
        knitr::kable("html") %>%
        kable_styling("striped", full_width = F)
    }
  
  output$table2 <- function() {
    # req(input$mpg)
    table2 %>%
      knitr::kable("html") %>%
      kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
  }
  output$consumption <- function() {
    # req(input$mpg)
    consumption %>%
      knitr::kable("html") %>%
      kable_styling("striped", full_width = F)
  }
  output$consumption_flav <- function() {
    # req(input$mpg)
    consumption_flav %>%
      knitr::kable("html") %>%
      kable_styling("striped", full_width = F)
  }
  
  
}



shinyApp(ui = ui, server = server)

Answer 1

如果您只想在 product_use 选项卡上时显示产品类别菜单，您可以将条件设置为以下内容：

condition = "input.tabBox_next_previous  == 'product_use'",

来自?conditionalPanel：

condition
A JavaScript expression that will be evaluated repeatedly to determine whether the panel should be displayed.

In the JS expression, you can refer to input and output JavaScript objects that contain the current values of input and output. For example, if you have an input with an id of foo, then you can use input.foo to read its value. (Be sure not to modify the input/output objects, as this may cause unpredictable behavior.)

根据条件在 R shiny 中显示/隐藏 selectinput

Show / Hide selectinput in R shiny based on conditions

r

shiny

shinyapps