如何在Shiny中实现点击DataTable行高亮对应shinyTree叶子节点

我正在构建一个能响应DataTable行点击事件的树形结构，希望点击表格行时，树形结构中对应的叶子节点自动高亮显示。以下是我的示例代码，卡在了响应点击事件后的树形节点处理部分：

library(shiny)
library(DT)
library(shinyTree)
library(shinyjs)

# Data.frame
data <- data.frame(
  ID = 1:10,
  Name = c("Alice", "Bob", "Charlie", "David", "Eve", "Frank", "Grace", "Hank", "Ivy", "Jack"),
  Age = c(25, 32, 45, 28, 40, 52, 34, 29, 37, 48),
  Score = c(85, 92, 78, 88, 76, 95, 81, 89, 70, 93)
)

ui <- fluidPage(
  DTOutput("table"),
  shinyTree("tree")
)

server <- function(input, output, session) {
  
  # Datatable
  output$table <- renderDT({
    datatable(data, selection = 'single', rownames = FALSE, callback = JS(
      "table.on('click', 'tr', function() {",
      "  var index = table.row(this).index();",
      "  Shiny.setInputValue('selected_row', index);",
      "});"
    ))
  })
  
  # Reactive highlight on click
  observeEvent(input$selected_row, {

    ### Strunggling from here ###

    create_tree(data, c("Age", "Name"))

    }
  )
}

期望的树形结构如下（点击表格中Bob行时，对应叶子节点Bob高亮）：

1  Root           
2   ¦--25         
3   ¦   °--Alice  
4   ¦--32         
5   ¦   °--Bob    
6   ¦--45         
7   ¦   °--Charlie
8   ¦--28         
9   ¦   °--David  
10  ¦--40         
11  ¦   °--Eve    
12  ¦--52         
13  ¦   °--Frank  
14  ¦--34         
15  ¦   °--Grace  
16  ¦--29         
17  ¦   °--Hank   
18  ¦--37         
19  ¦   °--Ivy    
20  °--48         
21      °--Jack   

解决方案 #

调整代码如下，核心是动态构建带选中状态的树形结构，并响应表格行点击更新高亮：

library(shiny)
library(DT)
library(shinyTree)
library(shinyjs)

# 数据集
data <- data.frame(
  ID = 1:10,
  Name = c("Alice", "Bob", "Charlie", "David", "Eve", "Frank", "Grace", "Hank", "Ivy", "Jack"),
  Age = c(25, 32, 45, 28, 40, 52, 34, 29, 37, 48),
  Score = c(85, 92, 78, 88, 76, 95, 81, 89, 70, 93)
)

ui <- fluidPage(
  useShinyjs(), # 加载shinyjs用于自动展开节点
  DTOutput("table"),
  shinyTree("tree", checkbox = FALSE) # 关闭复选框，仅保留高亮功能
)

server <- function(input, output, session) {
  
  # 渲染DataTable，使用自带的行选择逻辑
  output$table <- renderDT({
    datatable(data, selection = 'single', rownames = FALSE)
  })
  
  # 构建树形结构的函数，支持传入选中的Age和Name设置高亮
  build_tree <- function(selected_age = NULL, selected_name = NULL) {
    # 按Age分组生成节点
    age_groups <- split(data$Name, data$Age)
    tree_root <- list()
    
    for (age in names(age_groups)) {
      name_nodes <- list()
      for (name in age_groups[[age]]) {
        # 为选中节点添加selected属性实现高亮
        node_attr <- if (!is.null(selected_age) && !is.null(selected_name) && age == as.character(selected_age) && name == selected_name) {
          structure(list(), selected = TRUE)
        } else {
          list()
        }
        name_nodes[[name]] <- node_attr
      }
      tree_root[[age]] <- name_nodes
    }
    
    list(Root = tree_root)
  }
  
  # 初始渲染无高亮的树形
  output$tree <- renderTree({
    build_tree()
  })
  
  # 响应表格行点击，更新树形高亮
  observeEvent(input$table_rows_selected, {
    req(input$table_rows_selected)
    selected_row <- data[input$table_rows_selected, ]
    
    # 重新渲染树形，标记对应节点为选中
    output$tree <- renderTree({
      build_tree(selected_row$Age, selected_row$Name)
    })
    
    # 自动展开选中节点的父节点和自身（可选优化）
    runjs(sprintf("$('#tree').jstree('open_node', $('[data-jstree=\"%s\"]').parent());", selected_row$Age))
    runjs(sprintf("$('#tree').jstree('open_node', $('[data-jstree=\"%s\"]'));", selected_row$Name))
  })
}

shinyApp(ui, server)

关键说明 #

• 树形结构构建：通过build_tree函数动态生成符合shinyTree要求的列表结构，利用selected = TRUE属性标记需要高亮的节点。
• 表格选择优化：去掉自定义JS逻辑，直接使用DT自带的input$table_rows_selected获取选中行索引，更简洁可靠。
• 自动展开节点：使用shinyjs调用jstree的API，自动展开选中节点的父节点，确保用户能直接看到高亮的叶子节点。
• 关闭复选框：设置checkbox = FALSE避免复选框与高亮功能冲突，专注于行点击联动效果。

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