使用shinydashboard & shinyjs启动tabBox中的隐藏tabBox

Question

首先，让我给你们一些与我的问题相关的背景。我使用闪亮的，闪亮的和shinydashboard来创建一个动态的闪亮的应用程序。ShinyDashboard用于侧栏和头的漂亮布局，shinyjs根据用户的操作动态地隐藏/显示应用程序的特定元素。

现在，关于我的目标，，我希望我的应用程序的一个特定选项卡在启动时被隐藏(用户不可见)。我知道这个问题已经讨论过好几次了，但是找不到任何与我的问题直接相关的东西。实际上，虽然我在UI的几乎每个元素(例如: tabItem、fileInput、特定div)上使用shinyjs来隐藏使用shinyjs::hidden()函数隐藏的元素都没有问题，但似乎不适用于tabBox中的tabPanel (参见MWE中的示例)。在下面的示例中，我希望在开始时隐藏选项卡"Analysis“，并在执行某些操作(使用shinyjs::show())后再次显示给用户。

请注意，出于美观的原因，我希望使用tabBox而不是tabSetPanel，并且我怀疑这个问题与命名/ IDing相关联，这在使用shinyjs和shinyDashboard时有点具体(我记得从Dan的回复中读到了这个问题)。这也是我所做的一项测试的结果：

shinyjs::toggle(id = "analysis_setup_tab")和shinyjs::toggle(id = "shiny-tab-analysis_setup_tab")不起作用。

但是shinyjs::toggle(selector = "#generalData_tabBox li a[data-value=analysis_setup_tab]")起作用

因此，我希望shinyjs:hidden()也需要一些更改才能在选项卡上正确应用。但我不知道该改变什么。请注意，我对selctor / li类型的访问元素非常陌生，也不知道javascript。

请注意，我也尝试过以下方法，但没有成功：extendShinyjs(text = jsCode, functions = c("init")), &

shinyjs.init = function(){ $('#generalData_tabBox li a[data-value=analysis_setup_tab]').hide();}"

请在下面找到一个最低工作示例(MWE)来说明这个问题。

library(shiny)
library(shinyjs)
library(shinydashboard)
library(rlist)
library(DT)

# Global variables
use_userGuide <<- TRUE
counter <<- 0
counter_2 <<- 0

ui <- function(request) {
  ### Build global dashboard
  dashboardPage(
    dashboardHeader(title = div("Header")),
    dashboardSidebar(sidebarMenuOutput(outputId = "sidebar_menu")),
    dashboardBody(
      useShinyjs(),
      uiOutput("body"))
  )
}

menuItem_cover <- tabItem(tabName = "cover_tab", class="active",
                          fluidPage(
                            mainPanel(width = 12,
                                      div("This is the cover page")     
                            )))

menuItem_userGuide <- tabItem(tabName = "user_guide_tab",
                                 fluidPage(
                                   mainPanel(width = 12,
                                             div("Some user guide stuff")     
                                   )))       

menuSubItem_generalData <-
  tabItem(tabName = "generalData_tab",
    fluidPage(mainPanel(width = 12,
     tabBox(id="generalData_tabBox", width = 12,
         tabPanel("Portfolio",
                  value = 'portfolio_tab',
                  fluidRow( 
                    ## Load file from local
                    column(width = 12,
                           shinyjs::hidden(fileInput(
                             "portfolio",
                             "Select CSV File with Portfolio data",
                             accept = c("text/csv",
                                        "text/comma-separated-values,text/plain",
                                        ".csv")))
                    )
                  )
         ), # end of tabPanel
         
         shinyjs::hidden(
           tabPanel("Analysis Setup",
                                  value = 'analysis_setup_tab',
                                  fluidRow(
                                    column(width = 12,
                                           div(id="analysis_div",
                                            DT::dataTableOutput("analysis_setup_dt")
                                           )
                                    ) # Column end
                                  ) # fluid row end
         ) # Tabpanel 
         ) # end of hidden
     ))))

server <- function(input, output, session) {
  
  ## Initalisation of tabs in body
  body_list <- list(menuItem_cover)
  if(use_userGuide){body_list <- list.append(body_list,menuItem_userGuide)}
  body_list <- list.append(body_list,menuSubItem_generalData)
  
  ## Include items generated into the main body ##
  mainbody <<- do.call(tabItems, body_list)
  
  ## Render - Body ##
  output$body <- renderUI({
      div(mainbody)
  })
  
  # Setup sidebar content - serverside
  {
    # Initial empty list
    menu_list <- list()
    
    # Add  user guide tab
    if(use_userGuide){menu_list <- list.append(menu_list,menuItem("User Guide", tabName = "user_guide_tab"))}
    
    # Other tabs of the sidebar
    menu_list <- list.append(menu_list,
                             # Data Inputs
                             menuItem("Data",
                                      tabName = "dataG_tab",
                                      menuSubItem("General", tabName = "generalData_tab", selected = TRUE),
                                      
                                      # Load - button
                                      div(
                                        align = "center",
                                        actionButton("toggleAnalysis", "Toggle Analysis"),
                                        style = 'border-left:#fff;'
                                      ),
                                      
                                      # Load - button
                                      div(
                                        align = "center",
                                        actionButton("togglePortfolio", "Toggle Portfolio"),
                                        style = 'border-left:#fff;'
                                      ) 
                             )
    )
    
    # Make it a reactive list
    menu_vals = reactiveValues(menu_list = menu_list)
  }
 
  ## Render - Sidebar ##
  output$sidebar_menu <- renderMenu({
      menu_list <- list(menu_vals$menu_list)
      sidebarMenu(id="sidebar_menu",.list = menu_list)
  })
  
  output$analysis_setup_dt <- renderDataTable({mtcars})
  
  # If clicked make tab visible
  observeEvent(input$togglePortfolio, {
    shinyjs::toggle(id="portfolio")
  })
  
  # If clicked make tab visible
  observeEvent(input$toggleAnalysis, {
    #toggle(id="analysis_setup_tab") # Doesn't work (need selector)
    shinyjs::toggle(selector = "#generalData_tabBox li a[data-value=analysis_setup_tab]")
  })
}

shinyApp(ui, server)

提前谢谢你的帮助。非常感谢。

Answer 1

您可以在navbarPage中定义一个tabBox() ID，然后使用appendTab或removeTab显示或隐藏一个选项卡。尝尝这个

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

# Global variables
use_userGuide <<- TRUE
counter <<- 0
counter_2 <<- 0

jsCode <- "
shinyjs.init = function(){
          $('#analysis li a[data-value=analysis_setup_tab]').hide();
}
"


ui <- function(request) {
  ### Build global dashboard
  dashboardPage(
    dashboardHeader(title = "Header"),
    dashboardSidebar(sidebarMenuOutput(outputId = "sidebar_menu")),
    dashboardBody(
      useShinyjs() , 
      #extendShinyjs(text = jsCode, functions = c("init")),
      uiOutput("body")
      )
  )
}

menuItem_cover <- tabItem(tabName = "cover_tab", class="active",
                          fluidPage(
                            mainPanel(width = 12,
                                      div("This is the cover page")     
                            )))

menuItem_userGuide <- tabItem(tabName = "user_guide_tab",
                              fluidPage(
                                mainPanel(width = 12,
                                          div("Some user guide stuff")     
                                )))       

menuSubItem_generalData <-
  tabItem(tabName = "generalData_tab",
          fluidPage(mainPanel(width = 12,
                              tabBox(id="generalData_tabBox", width = 12,
                                     
                                     navbarPage("", id = "analysis",
                                     tabPanel("Portfolio",
                                              value = 'portfolio_tab',
                                              fluidRow( 
                                                ## Load file from local
                                                column(width = 12,
                                                       shinyjs::hidden(fileInput(
                                                         "portfolio",
                                                         "Select CSV File with Portfolio data",
                                                         accept = c("text/csv",
                                                                    "text/comma-separated-values,text/plain",
                                                                    ".csv")))
                                                )
                                              )
                                     )#, # end of tabPanel
                                    #shinyjs::hidden(  ##  this does not seem to work
                                       # tabPanel("Analysis Setup",
                                       #          value = 'analysis_setup_tab', 
                                       #          fluidRow(
                                       #            column(width = 12,
                                       #                   div(id="analysis_div",
                                       #                       DTOutput("analysis_setup_dt")
                                       #                   )
                                       #            ) # Column end
                                       #          ) # fluid row end
                                       # ) # Tabpanel
                                    #)
                                   )
                                     
                              ))))

server <- function(input, output, session) {
  
  ## Initalisation of tabs in body
  body_list <- list(menuItem_cover)
  if(use_userGuide){body_list <- list(body_list,menuItem_userGuide)}
  body_list <- list(body_list,menuSubItem_generalData)
  
  ## Include items generated into the main body ##
  # mainbody <- do.call(tabItems, body_list)   ##  this did not work for me
  
  ## Render - Body ##
  output$body <- renderUI({
    #div(mainbody)
    tagList(
      tabItems(
        menuItem_cover,
        menuItem_userGuide,
        menuSubItem_generalData
      )
    )
  })
  
  # Setup sidebar content - serverside
  {
    # Initial empty list
    menu_list <- list()
    menu_list <- list(menu_list,menuItem("Cover Tab", tabName = "cover_tab"))
    # Add  user guide tab
    if(use_userGuide){menu_list <- list(menu_list,menuItem("User Guide", tabName = "user_guide_tab"))}
    
    # Other tabs of the sidebar
    menu_list <- list(menu_list,
                             # Data Inputs
                             menuItem("Data",
                                      tabName = "dataG_tab",
                                      menuSubItem("General", tabName = "generalData_tab", selected = TRUE),
                                      
                                      # Load - button
                                      div(
                                        align = "center",
                                        actionButton("toggleAnalysis", "Toggle Analysis"),
                                        style = 'border-left:#fff;'
                                      ),
                                      
                                      # Load - button
                                      div(
                                        align = "center",
                                        actionButton("togglePortfolio", "Toggle Portfolio"),
                                        style = 'border-left:#fff;'
                                      ) 
                             )
    )
    
    # Make it a reactive list
    menu_vals = reactiveValues(menu_list = menu_list)
  }
  
  ## Render - Sidebar ##
  output$sidebar_menu <- renderMenu({
    menu_list <- list(menu_vals$menu_list)
    sidebarMenu(id="sidebar_menu",.list = menu_list)
  })
  
  output$analysis_setup_dt <- renderDT({mtcars})
  output$mycars <- renderDT(cars)
  
  # If clicked make tab visible
  observeEvent(input$togglePortfolio, {
    shinyjs::toggle(id="portfolio")
  })
  
  observe({
    if (is.null(input$toggleAnalysis)){
      shinyjs::hide(selector = '#analysis li a[data-value="analysis_setup_tab"]')
    }
  })
  
  ### If clicked make tab visible
  observeEvent(input$toggleAnalysis, {
    #toggle(id="analysis_setup_tab") # Doesn't work (need selector)
    #shinyjs::toggle(selector = "#generalData_tabBox li a[data-value='analysis_setup_tab']")
    
    #shinyjs::toggle(selector = '#analysis li a[data-value="analysis_setup_tab"]')   ## not hidden on initial load
    
    ### alternative to toggle is appendTab or removeTab
    k <- as.numeric(input$toggleAnalysis) %% 2
    print(k)
    if (k==1){
      appendTab(inputId = "analysis", tab = tabPanel("Analysis Setup", value = "tab2_val", br(), DTOutput("analysis_setup_dt")))
      #show(selector = '#analysis li a[data-value="analysis_setup_tab"]')
    }else{
      removeTab(inputId = "analysis", target = "tab2_val" , session = getDefaultReactiveDomain())
      #hide(selector = '#analysis li a[data-value="analysis_setup_tab"]')
    }
    
  },ignoreInit = TRUE)
}

shinyApp(ui, server)