使用shinydashboard和shinyjs在tabBox中启动时隐藏tabPanel

     2023-03-24     189

关键词:

【中文标题】使用shinydashboard和shinyjs在tabBox中启动时隐藏tabPanel【英文标题】:Hidden tabPanel on startup within tabBox using shinydashboard & shinyjs 【发布时间】: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)

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

【问题讨论】:

【参考方案1】:

您可以在tabBox() 中定义navbarPage ID,然后使用appendTabremoveTab 显示或隐藏选项卡。试试这个

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 保留初始布局。

用shinyjs改变shinydashboard框的样式

】用shinyjs改变shinydashboard框的样式【英文标题】:Changestyleofshinydashboardboxwithshinyjs【发布时间】:2021-06-1319:11:37【问题描述】:我正在尝试根据用户所在的选项卡更改闪亮仪表板框的颜色。为此,我从tabsetPanel获取输入值,并尝... 查看详情

将垂直滚动条添加到 shinyjs 下拉按钮 - 闪亮

...单添加垂直滚动条。请检查我的代码,library(shiny)library(shinydashboard)libra 查看详情

Shinydashboard 使下载按钮变灰?

】Shinydashboard使下载按钮变灰?【英文标题】:ShinydashboardgrayedoutdownloadButton?【发布时间】:2016-07-1819:23:06【问题描述】:如何修复这个简单示例中的下载按钮?library(shiny)library(shinydashboard)library(shinyjs)header<-dashboardHeader()sidebar&... 查看详情

使用 shinyjs 和 flexdashbord 动态显示/隐藏输入

】使用shinyjs和flexdashbord动态显示/隐藏输入【英文标题】:Dynamicallyshow/hideinputwithshinyjsandflexdashbord【发布时间】:2017-05-1823:25:18【问题描述】:点击标签时尝试更新flexdashboard中的侧边栏。无法让它工作。---title:"TestSidebar"output:flex... 查看详情

使用 shinyjs 使用 javascript 在闪亮的应用程序中操作现有的传单地图

】使用shinyjs使用javascript在闪亮的应用程序中操作现有的传单地图【英文标题】:ManipulateexistingLeafletmapinashinyappwithjavascriptusingshinyjs【发布时间】:2018-10-0712:47:30【问题描述】:我有一个闪亮的应用程序,其中包含现有的传单地... 查看详情

ggplotly 和 shinydashboard 框的布局问题

】ggplotly和shinydashboard框的布局问题【英文标题】:Layoutproblemswithggplotlyandshinydashboardboxes【发布时间】:2021-11-1903:30:55【问题描述】:我遇到了ggplotly对象的问题,它根本没有留在带有闪亮和闪亮仪表板的盒子里。在绘制某些东西... 查看详情

启用/禁用不使用 flexdashboard+shinyjs

】启用/禁用不使用flexdashboard+shinyjs【英文标题】:Enable/disablenotworkingwithflexdashboard+shinyjs【发布时间】:2020-01-2404:00:57【问题描述】:我知道thisissue并且它显然已经解决了,但我仔细检查了我是否有相关软件包的最新版本,disable... 查看详情

使用 shinyjs 切换表单水平输入及其标签

】使用shinyjs切换表单水平输入及其标签【英文标题】:Togglingaform-horizontalinputanditslabelusingshinyjs【发布时间】:2019-11-0720:56:36【问题描述】:下面的应用程序有两个selectInputs(month_abbr和month_full)和一个checkboxInput(abbr)。我想在... 查看详情

使用javascript使用shinyjs将数据表导出为shiny中的csv

...部,包括所有下拉菜单选项,或输出HTML)。我正在尝试使用Javascript导出我拥有的数据。为此,我使用以下基于以下downloadcsv.js创建的外部Javascript函数guide:shinyjs.myfunction=function(ar 查看详情

使用 ShinyJS 初始化隐藏元素

】使用ShinyJS初始化隐藏元素【英文标题】:InitalisinghiddenelementswithShinyJS【发布时间】:2020-02-1218:25:17【问题描述】:我想在闪亮的应用程序启动时隐藏一个元素,但与thisexample不同的是,要隐藏的元素是可见的较大元素的一部分... 查看详情

shinydashboard ui.R 和 server.R 未读取 Global.R

】shinydashboardui.R和server.R未读取Global.R【英文标题】:shinydashboardui.Randserver.RnotreadingGlobal.R【发布时间】:2017-02-0116:42:17【问题描述】:在RStudio中开发时,我成功地使用global.R将数据传递给ui.r和server.R。但是,当我将代码迁移到服... 查看详情

shinyjs 不会隐藏使用 renderUI 创建的按钮

】shinyjs不会隐藏使用renderUI创建的按钮【英文标题】:shinyjswon\'thidebuttoncreatedwithrenderUI【发布时间】:2021-06-2616:14:02【问题描述】:我有一个使用shinyproxy制作的闪亮应用程序。在server.R上,我使用renderUI创建了一些UI元素,如下... 查看详情

在最近的更新之后,使用 shinyjs 重置 event_data 似乎不再起作用

】在最近的更新之后,使用shinyjs重置event_data似乎不再起作用【英文标题】:Resetevent_datausingshinyjsdoesn\'tseemtoworkanymore,aftertherecentupdate【发布时间】:2019-11-0811:06:46【问题描述】:我正在为一个又大又笨重的闪亮仪表板维护我的代... 查看详情

在 Shinydashboard 中渲染 ggplot 时出现致命错误

】在Shinydashboard中渲染ggplot时出现致命错误【英文标题】:Fatalerrorwhenrenderingggplotinshinydashboard【发布时间】:2021-11-1512:02:56【问题描述】:在闪亮仪表板中渲染ggplot时出现R致命错误(重磅炸弹->重新启动会话)。基本hist绘图的... 查看详情

将公司徽标添加到 ShinyDashboard 标题

】将公司徽标添加到ShinyDashboard标题【英文标题】:AddingacompanyLogotoShinyDashboardheader【发布时间】:2015-10-0502:14:44【问题描述】:很好奇,有没有办法在ShinyDashboard的标题中添加公司徽标?当我查看documentation时,它描述了更改CSS中... 查看详情

错误:shinyjs:extendShinyjs:必须提供`functions`参数

...。数据可视化应用程序在我同事的计算机上正常运行(他使用旧软件包版本)。从我在网上收集的信息来看,我的问 查看详情

无法将元素放置到内联块

...我需要元素并排放置,而不是在块中。library(shiny)library(shinydashboard)library(shinyjs)ui<-dashboardPage(das 查看详情

如何使用shinyjs从闪亮的应用程序物理打印png?

】如何使用shinyjs从闪亮的应用程序物理打印png?【英文标题】:Howtophysicallyprintapngfromashinyappwithshinyjs?【发布时间】:2019-12-0506:53:04【问题描述】:我正在尝试从闪亮的应用程序中物理打印图像,我已经阅读过:RShinyprintcurrentpage... 查看详情