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

Question

这是这个one的后续问题。

在将过滤器更新到由

renderDT

显示的表格时，我尝试保留所选行：

注意：id 是

town

，表格按

value

列排列。即使重新安排线路，我也希望保留所选城镇。

如果我更改年份，所选行会以不一致的方式更改：

这是代码：

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_at(input$col) |> pull(town)) %in% selection )
                     ),
  )
  
}

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

Answer 1

这里有一个选项可以在切换年份后保留所选行。我做了一些改变。

最大的一个是使用

observeEvent

而不是

observe

。观察事件只会“侦听”何时选择一行并更新反应值

rv$selection

。

我也没有看到

input$col

，所以我硬编码了

value

。

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