更新DT表格内容时如何保留选中行？

这是相关问题的后续提问，我尝试在更新renderDT展示的表格筛选条件（切换年份）时保留选中行：

注：唯一标识为town字段，表格按value列排序。预期即使行顺序重排，选中的town仍能被保留，但切换年份时，选中行的变化并不稳定。

原代码 #

library(tidyverse)
library(shiny)
library(DT)

df <- tribble(~ town     , ~ year  , ~ value,
              "A"        , 2000    ,  80   ,
              "B"        , 2000    ,  90    ,
              "C"        , 2000     , 100    ,
              
              "A"        , 2001    ,  90    ,
              "B"        , 2001    ,  80    ,
              "C"        , 2001    ,  100   ,
              
              "A"        , 2002    ,  90    ,
              "B"        , 2002    ,  100    ,
              "C"        , 2002    ,  80   ,
              )

ui <- fluidPage(
  
  radioButtons(
    inputId = "year",
    label = "Choose a year",
    choices = unique(df$year)
  ),
  
  DTOutput("table", width = "400px"),
  
  h4("Click on first line and then change the year..."),
  
  textOutput("debug"),
  
)

server <- function(input, output, session) {
  
  out <- reactiveVal()
  
  observe(
    out(df |> filter(year == input$year) |> arrange(value))
  )
  
  selection <- NULL
  
  observe({
    selection <<- (out() |> pull(town))[input$table_rows_selected]
    output$debug <- renderText(selection)
  })
  
  output$table <- renderDT(
    out(),
    options = list(dom = 't', pageLength = 10000, ordering = FALSE),
    selection = list(mode = "multiple",
                     selected =
                       which((df |> arrange(value) |> pull(town)) %in% selection )
                     ),
  )
  
}

shinyApp(ui, server, options = list(
  launch.browser = TRUE
))

问题根源 #

1. 使用全局变量selection存储选中的town，Shiny的反应式环境无法正确追踪其变化，导致更新不同步。
2. 计算选中行索引时，错误地使用了全量数据df的排序结果，而非当前筛选后的out()数据，导致行索引匹配错误。

修复方案 #

用reactiveVal存储选中的town列表，确保反应式环境能正确追踪更新；同时基于当前筛选排序后的数据集计算选中行的索引。

修复后的代码 #

library(tidyverse)
library(shiny)
library(DT)

df <- tribble(~ town     , ~ year  , ~ value,
              "A"        , 2000    ,  80   ,
              "B"        , 2000    ,  90    ,
              "C"        , 2000     , 100    ,
              
              "A"        , 2001    ,  90    ,
              "B"        , 2001    ,  80    ,
              "C"        , 2001    ,  100   ,
              
              "A"        , 2002    ,  90    ,
              "B"        , 2002    ,  100    ,
              "C"        , 2002    ,  80   ,
              )

ui <- fluidPage(
  
  radioButtons(
    inputId = "year",
    label = "Choose a year",
    choices = unique(df$year)
  ),
  
  DTOutput("table", width = "400px"),
  
  h4("Click on first line and then change the year..."),
  
  textOutput("debug"),
  
)

server <- function(input, output, session) {
  
  out <- reactiveVal()
  
  # 存储选中的town列表
  selected_towns <- reactiveVal(c())
  
  # 更新筛选后的数据集
  observe({
    filtered_df <- df |> filter(year == input$year) |> arrange(value)
    out(filtered_df)
  })
  
  # 监听表格选中行，更新选中的town
  observeEvent(input$table_rows_selected, {
    if(!is.null(input$table_rows_selected)){
      selected <- out() |> pull(town) |> .[input$table_rows_selected]
      selected_towns(selected)
    } else {
      selected_towns(c())
    }
  })
  
  # 渲染表格，基于当前数据集匹配选中行索引
  output$table <- renderDT(
    out(),
    options = list(dom = 't', pageLength = 10000, ordering = FALSE),
    selection = list(
      mode = "multiple",
      selected = which(out()$town %in% selected_towns())
    )
  )
  
  # 调试输出
  output$debug <- renderText(paste("Selected towns:", paste(selected_towns(), collapse = ", ")))
  
}

shinyApp(ui, server, options = list(
  launch.browser = TRUE
))

关键修改说明 #

1. 新增selected_towns <- reactiveVal(c())，用反应式变量存储选中的town，确保Shiny能追踪其变化并触发相关更新。
2. 使用observeEvent监听input$table_rows_selected，仅在选中行变化时更新selected_towns，避免不必要的触发。
3. 渲染表格时，通过which(out()$town %in% selected_towns())在当前筛选后的数据集里匹配选中town的行索引，保证行顺序变化时仍能正确选中目标行。

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