Shiny中实现点击DT表格行展示剩余列详情（同区域）

library(shiny)
library(DT)

ui <- fluidPage(
  br(),
  splitLayout(
    DTOutput("dtable1"),
    uiOutput("details_table")  # 替换原DT表格为UI输出，用于渲染自定义HTML详情
  )
)

# 修改JS回调：获取点击行的1-based索引并传递给Shiny
js <- function(id){ 
  c(
    "table.on('click', 'tr', function(){",
    "var index = table.row(this).index() + 1;", // 转换为R的1-based索引
    sprintf("Shiny.setInputValue('%s', index, {priority: 'event'});", id),
    "});"
  )
}

server <- function(input, output, session){
  
  output[["dtable1"]] <- renderDT({
    datatable(iris['Sepal.Length'], callback = JS(js("t1")), selection = 'single')
  })
  
  # 反应式获取选中行的剩余列数据
  selected_row_data <- reactive({
    req(input$t1)  # 等待用户点击行的索引输入
    # 提取除Sepal.Length外的所有列
    iris[input$t1, setdiff(colnames(iris), "Sepal.Length"), drop = FALSE]
  })
  
  # 渲染HTML格式的详情表格
  output$details_table <- renderUI({
    req(selected_row_data())
    df <- selected_row_data()
    
    # 生成带Bootstrap样式的HTML表格
    tags$table(class = "table table-striped table-bordered",
               tags$thead(
                 tags$tr(lapply(colnames(df), tags$th))
               ),
               tags$tbody(
                 tags$tr(lapply(df[1, ], tags$td))
               )
    )
  })
}

shinyApp(ui, server)

关键改动说明 #

• UI层调整：将原有的第二个DTOutput替换为uiOutput，允许动态渲染自定义HTML内容，而非固定的DT表格
• JS回调优化：修改JavaScript逻辑，获取点击行的索引并转换为R的1-based计数，确保能精准定位到iris数据集中的对应行
• 数据处理与渲染：
  • 通过reactive对象实时响应用户点击，提取对应行的剩余列数据
  • 使用Shiny的tags函数生成带Bootstrap样式的HTML表格，既满足展示需求，又保持界面风格统一

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