使用shinydashboard和shinyjs在tabBox中启动时隐藏tabPanel
Posted
技术标签:
【中文标题】使用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，然后使用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 保留初始布局。以上是关于使用shinydashboard和shinyjs在tabBox中启动时隐藏tabPanel的主要内容，如果未能解决你的问题，请参考以下文章