Shinydashboard切换面板时shinyTree渲染消失问题求助

问题描述 #

我在工作场景中构建shinydashboard，用于展示各分支人员技能方向的可搜索表格。侧边栏设置两个菜单项：

• 按地点筛选：采用shinyTree树形结构（国家/城市/姓名层级）
• 按技术筛选：使用按钮组+复选框

切换面板时，若未关闭当前面板就打开另一个，shinyTree会消失且无法恢复。通过页面检查发现，对应<ul class="jstree-container-ul jstree-children jstree-no-icons jstree-striped" role="group">元素被添加了style="display: none;"样式，重新打开"按地点"面板时该样式不会自动覆盖。只有在搜索框输入内容时，该元素才会恢复display:block，但需要实现点击"按地点"面板时就强制恢复样式。

解决方案 #

利用shinyjs结合自定义JavaScript，监听侧边栏菜单的点击事件，当切换到"By Location"（tabName为location）面板时，强制将shinyTree对应的ul元素设置为display:block。

修改后的完整代码 #

library(shiny)
library(shinyTree)
library(shinyjs)
library(shinyWidgets) # 加载依赖包，actionBttn需要此包

ui <- dashboardPage(
  dashboardHeader(title = "Filters"),
  dashboardSidebar(
    useShinyjs(),
    # 添加自定义JS监听菜单点击事件
    tags$script(HTML("
      $(document).on('click', '.sidebar-menu li a[href=\"#shiny-tab-location\"]', function() {
        // 延迟执行确保面板已展开，避免DOM元素未就绪
        setTimeout(function() {
          $('.jstree-container-ul.jstree-children.jstree-no-icons.jstree-striped').css('display', 'block');
        }, 100);
      });
    ")),
    sidebarMenu(
      menuItem("By Location", tabName = "location", icon = icon("earth-europe"),
               div(
                 style = "max-height: 42vh; overflow-y: auto; overflow-x: auto;",
                 shinyTree("tree", stripes = TRUE, multiple = TRUE, animation = TRUE, checkbox = TRUE, search=TRUE, themeIcons = FALSE)
               )
      ),
      menuItem("By Technique", tabName = "technique", icon = icon("microscope"),
               fluidRow(
                 column(3, actionBttn(inputId = "group1_btn", label = "Btn1", style = "jelly", color = "danger")),
                 column(3, actionBttn(inputId = "group2_btn", label = "Btn1", style = "jelly", color = "danger")),
                 column(3, actionBttn(inputId = "group3_btn", label = "Btn1", style = "jelly", color = "danger"))
               ),
               uiOutput("technique_checkboxes")
      ))),
  dashboardBody(
    DTOutput("table")
  ))

server <- function(input, output, session) {
  output$tree <- renderTree({
    list(
      root1 = list(
        SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListAB = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListAC = list(leaf1 = "", leaf2 = "", leaf3="")
      ),
      root2 = list(
        SubListB = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListBA = list(leaf1 = "", leaf2 = "", leaf3=""),
        SubListBC = list(leafA = "", leafB = "")
      )
    )
  })
  
  # 补充技术筛选的复选框输出，避免报错
  output$technique_checkboxes <- renderUI({
    checkboxGroupInput("tech_checks", "Select Techniques", choices = c("Tech1", "Tech2", "Tech3"))
  })
  
  # 示例表格输出
  output$table <- renderDT({
    data.frame(Name = c("John", "Jane", "Bob"), 
               Location = c("root1/SubListA", "root2/SubListB", "root1/SubListAC"),
               Skills = c("Python", "R", "Java"))
  })
}

shinyApp(ui,server)

关键说明 #

• 自定义JS通过监听sidebar-menu中指向#shiny-tab-location的链接点击事件，触发样式修改
• 使用setTimeout延迟100ms执行，确保面板完成展开动作，避免DOM元素未就绪时修改无效
• 选择器.jstree-container-ul.jstree-children.jstree-no-icons.jstree-striped精准定位shinyTree的目标ul元素，强制设置display:block

修改后，每次切换回"By Location"面板时，shinyTree都会自动显示，无需依赖搜索框触发。

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