2

我正在尝试使用条件来显示或隐藏 R 闪亮应用程序中的选择输入，基于选项卡在 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)

4

1 回答 1

3

如果您只想在 product_use 选项卡上显示 Product Category 菜单，您可以将条件设​​置为以下内容：

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

来自?conditionalPanel：

条件
将重复计算以确定是否应显示面板的 JavaScript 表达式。

在 JS 表达式中，您可以引用包含输入和输出当前值的输入和输出 JavaScript 对象。例如，如果您有一个 id 为 foo 的输入，那么您可以使用 input.foo 来读取它的值。（确保不要修改输入/输出对象，因为这可能会导致不可预知的行为。）

于 2018-05-17T20:05:54.027 回答