Показать / Скрыть выбор входа в R блестящий в зависимости от условий

Question

Я пытаюсь использовать условия, чтобы отобразить или скрыть выбранные входы в блестящем приложении R, если вкладка доступна в пользовательском интерфейсе или нет. Таким образом, на вкладке с заголовком 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:

условие
Выражение JavaScript, которое будет неоднократно оцениваться для определения необходимости отображения панели.

В выражении JS вы можете ссылаться на ввод и вывод JavaScriptобъекты, которые содержат текущие значения ввода и вывода.Например, если у вас есть вход с идентификатором foo, вы можете использовать input.foo, чтобы прочитать его значение.(Не изменяйте объекты ввода / вывода, так как это может привести к непредсказуемому поведению.)