基于响应式条件在Shiny中隐藏tabPanel及嵌套子标签页

实现思路 #

• 需求核心是让标签显隐和响应式权限变量permission_color()绑定，要么让UI渲染逻辑依赖该变量，要么用观察者监听权限变化主动操作标签显隐
• 以下实现方案基于shinyjs原生的showTab/hideTab函数开发，性能更优，不需要每次权限变化都重新渲染整个标签组，可直接适配实际业务中shinymanager生成的权限变量

完整可运行代码 #

library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyjs)
library(tidyverse)

options(warn=-1)
data(iris)
data(mtcars)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    shinyjs::useShinyjs(),
    sidebarMenu(id = "menume",
                sidebarMenuOutput("colormenu"),
                menuItem("MTCARS", tabName = "mt", icon = icon("user-tie")),
                selectInput("mtvar", "Choose a variable", choices = colnames(mtcars)),
                menuItem("IRIS", icon = icon("envelope-open-text"), tabName = "ir"),
                selectInput("irvar", "Choose a variable", choices = colnames(iris))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem("mt", uiOutput("mttabs")),
      tabItem("ir", uiOutput("irtabs"))
    )
  )
)

server <- function(input, output, session) {
  
  output$colormenu = renderMenu({
    selectInput("colorme", "Choose a color", c("red", "yellow", "green", "blue", "black"))
  })
  
  permission_color = reactive({
    req(input$colorme)
    # 实际业务场景可替换为shinymanager的权限判断逻辑
    input$colorme =="green"
  })
  
  # 核心逻辑：监听权限变化，动态控制两个页面的Plots标签显隐
  observeEvent(permission_color(), {
    if(permission_color()){
      showTab(inputId = "mtcarstabsall", target = "Plots")
      showTab(inputId = "iristabsall", target = "Plots")
    }else{
      hideTab(inputId = "mtcarstabsall", target = "Plots")
      hideTab(inputId = "iristabsall", target = "Plots")
    }
  })
  
  output$mttabs = renderUI({
    output$mtcarsplot1=renderPlot({
      ggplot(mtcars, aes_string(x = input$mtvar)) + stat_bin(nbins = 10)
    })
    
    output$mtcarsplot2=renderPlot({
      ggplot(mtcars, aes_string(x = input$mtvar)) + geom_density()
    })
    
    output$mtcarstable1=renderTable({
      tabme= head(mtcars, 5)
      tabme
    })
    
    tabsetPanel(id = "mtcarstabsall",
                tabPanel("Tables",
                         tabsetPanel(id = "mttables",
                                     tabPanel(id = "mttable","MTcars tables",value=1,
                                              fluidRow(box(title = "Table 1",  tableOutput("mtcarstable1")))
                                     ))),
                tabPanel("Plots",
                         tabsetPanel(id = "mtplotsall",
                                     tabPanel(id = "mtplots","mtcars plots",value=2,
                                              fluidRow(box(title = "Plot1", plotOutput("mtcarsplot1"))
                                              )),
                                     tabPanel(id = "mtplots2","mtcars plots 2",value=3,
                                              fluidRow(box(title = "Plot2", plotOutput("mtcarsplot2")))))
                ))
  })
  
  output$irtabs = renderUI({
    output$irisplot1=renderPlot({
      ggplot(iris, aes_string(x = input$irvar)) + stat_bin(nbins = 10)
    })
    
    output$irisplot2=renderPlot({
      ggplot(iris, aes_string(x = input$irvar)) + geom_density()
    })
    
    output$iristable1=renderTable({
      tabme = head(iris, 5)
      tabme
    })
    
    tabsetPanel(id = "iristabsall",
                tabPanel("Tables",
                         tabsetPanel(id = "iristables",
                                     tabPanel(id = "irtable","iris tables",value=4,
                                              fluidRow(box(title = "Table 1",  tableOutput("iristable1")))
                                     ))),
                tabPanel("Plots",
                         tabsetPanel(id = "irisplotsall",
                                     tabPanel(id = "irisplots","iris plots",value=5,
                                              fluidRow(box(title = "Plot1", plotOutput("irisplot1"))
                                              )),
                                     tabPanel(id = "irisplots2","iris plots 2",value=6,
                                              fluidRow(box(title = "Plot2", plotOutput("irisplot2"))
                                              )))
                ))
  })
}

shinyApp(ui, server)

关键说明 #

• 已修正原代码中permission_color取值的输入ID错误，避免初始化报错
• 显隐逻辑和权限来源完全解耦，只需要修改permission_color()的返回逻辑即可适配不同业务场景的权限规则
• 权限变量每发生一次变化就会触发一次显隐逻辑，完全满足动态生效的要求，不会出现一次显示永久生效的问题

内容的提问来源于stack exchange，提问作者Marissa