多会话Shiny应用编辑DT表格时，筛选与排序丢失问题排查

应用核心需求 #

• 数据源支持多用户共享（多会话）
• DT表格可编辑，修改需同步至数据源，供其他用户查看
• 每个用户仅能查看数据源的子集（实际应用中子集可能重叠）
• DT需支持全局搜索和表头筛选

问题详情 #

已实现上述所有需求，但存在严重副作用：

• 每次编辑表格值后，筛选条件和行排序都会被清除
• 当DT接收响应式数据（即数据随时间变化）时，全局搜索、表头筛选条件以及行排序状态无法保留
• 更严重的是出现会话间数据泄漏：用户修改数据后，所有会话（包括自身）的数据视图都会被改变

不确定这是Bug、特性还是知识盲区，以下是可在Shinylive中运行的最小复现示例：

app.R #

library(shiny)
library(data.table)
library(bslib)
library(DT)

# Initialize shared data if it doesn't exist
if (!file.exists("shared_data.csv")) {
   initial_data <- data.table(
      id = 1:10,
      user = rep(c("user1", "user2"), each = 5),
      value = sample(1:100, 10),
      notes = paste("Note", 1:10)
   )
   fwrite(initial_data, "shared_data.csv")
}

# Main UI function
ui <- page_sidebar(
   title = "Shared Data Editor",
   sidebar = sidebar(
      userSelectUI("user_select")
   ),
   dataTableUI("data_view")
)

# Main server function
server <- function(input, output, session) {
   
   # Reactive data reader
   data_reactive <- reactiveFileReader(
      intervalMillis = 1000,
      session = session,
      filePath = "shared_data.csv",
      readFunc = fread
   )
   
   # Get selected user from the user selection module
   selected_user <- userSelectServer("user_select")
   
   # Pass the selected user to the data table module
   dataTableServer("data_view", data_reactive, selected_user)
}

shinyApp(ui, server)

user_select_module.R #

userSelectUI <- function(id) {
   ns <- NS(id)
   tagList(
      selectInput(ns("user"), "Select User:", 
                  choices = c("user1", "user2"),
                  selected = "user1"),
      hr(),
      helpText("Note: Changes are saved automatically")
   )
}

userSelectServer <- function(id) {
   moduleServer(id, function(input, output, session) {
      return(reactive(input$user))
   })
}

data_table_module.R #

dataTableUI <- function(id) {
   ns <- NS(id)
   card(
      card_header("Your Data View"),
      DTOutput(ns("data_table"))
   )
}

dataTableServer <- function(id, data_reactive, selected_user) {
   moduleServer(id, function(input, output, session) {
      ns <- session$ns
      
      # Filter data for current user
      filtered_data <- reactive({
         data_reactive()[user == selected_user()]
      })
      
      # 创建表格代理
      dt_proxy <- dataTableProxy(ns("data_table"))
      
      # 渲染可编辑表格
      output$data_table <- renderDT({
         datatable(
            filtered_data(),
            editable = TRUE,
            filter = list(position = "top", clear = FALSE),
            options = list(
               pageLength = 25,
               lengthMenu = c(25, 50, 100),
               searchHighlight = TRUE,
               dom = "lrtip",  # 移除'f'避免重复搜索框
               stateSave = TRUE,  # 保留筛选与排序状态
               stateDuration = -1,
               processing = FALSE,
               search = list(regex = TRUE, caseInsensitive = TRUE),
               language = list(
                  search = "Filter:"
               )
            )
         ) %>%
            formatStyle(0, target = "row", lineHeight = "80%")
      }, server = TRUE)  # 使用服务器端处理避免重置
      
      # 处理单元格编辑
      observeEvent(input$data_table_cell_edit, {
         info <- input$data_table_cell_edit
         row_index <- info$row
         col_name <- names(filtered_data())[info$col]
         new_value <- info$value
         
         # 读取当前数据
         current_data <- fread("shared_data.csv")
         
         # 找到完整数据集中的对应行
         full_data_row <- which(current_data$user == selected_user())[row_index]
         
         # 更新值
         current_data[full_data_row, (col_name) := new_value]
         
         # 写回文件
         fwrite(current_data, "shared_data.csv")
         
         # 更新表格，不重置筛选/排序
         replaceData(dt_proxy, filtered_data(), resetPaging = FALSE, rownames = FALSE)
         
      })
   })
}

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