【问题标题】:Hidden tabPanel on startup within tabBox using shinydashboard & shinyjs使用shinydashboard和shinyjs在tabBox中启动时隐藏tabPanel
【发布时间】:2021-06-19 01:04:33
【问题描述】:

首先让我给你一些与我的问题相关的背景。 我正在使用 shiny、shinyjs 和 shinydashboard 创建一个动态的 Shiny 应用程序。 ShinyDashboard 用于侧边栏和标题的漂亮布局,shinyjs 用于根据用户操作动态隐藏/显示应用程序的特定元素。

现在,关于我的目标,我希望在启动时隐藏我的应用的特定标签(用户不可见)。我知道这已经在 SO 上多次介绍过,但找不到与我的问题直接相关的任何内容。事实上,虽然我在 UI 的几乎每个元素(例如:tabItem、fileInput、特定 div)上使用 shinyjs 来使用 shinyjs::hidden() 函数隐藏元素都没有问题,但似乎 它不适用于 tabPanel在 tabBox 内(参见 MWE 中的示例)。在下面的示例中,我希望在开始时隐藏“分析设置”选项卡,稍后在某些操作后再次向用户显示(使用 shinyjs::show())。

请注意,出于美学原因,我希望使用 tabBox 而不是 tabSetPanel,并且我怀疑该问题与命名/ IDing 相关联,这在将 shinyjs 与 shinyDashboard 结合使用时有点具体(我记得读过这来自 Dan Ataali 的回应中的某处)。这也是我在哪里进行的测试的结果:

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)

非常感谢您的帮助。将不胜感激。

【问题讨论】:

    标签: r shiny shinydashboard shinyjs


    【解决方案1】:

    您可以在tabBox() 中定义navbarPage 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)
    

    【讨论】:

    • 您好 YBS,感谢您的回答,非常感谢您的快速响应。但是,虽然它确实解决了在初始设置时将所需选项卡“隐藏”给用户的问题,但由于将 navbarPage 包裹在选项卡周围,我不喜欢选项卡中的布局。理想情况下,我想使用 tabBox 保留初始布局。
    猜你喜欢
    • 2019-04-02
    • 1970-01-01
    • 2018-03-13
    • 2021-06-02
    • 2021-01-27
    • 2017-05-18
    • 2018-02-13
    • 2020-02-12
    • 2018-12-22
    相关资源
    最近更新 更多