Shiny中DT切换分类保留修改并高亮编辑单元格问题

需求与问题 #

需要实现两个功能：

• 切换左侧Species下拉框时，保留DT表格的编辑内容（已实现）
• 编辑过的单元格自动高亮显示（当前未生效）

以下是尝试的代码：

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

js <- HTML(
  "function colorizeCell(i, j){
    var selector = '#dtable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
    $(selector).css({'background-color': 'yellow'});
  }"
)

colorizeCell <- function(i, j){
  sprintf("colorizeCell(%d, %d)", i, j)
}

ui<-fluidPage(  useShinyjs(),
                tags$head(
                  tags$script(js)
                ),
  
                 sidebarLayout(
                   sidebarPanel(width = 3,
                                inputPanel(
                                  selectInput("Species", label = "Choose species",
                                              choices = levels(as.factor(iris$Species)))
                                )),
                   
                   

                   mainPanel( tabsetPanel(
                     tabPanel("Data Table",DTOutput("iris_datatable"),
                             hr()))
                 )
               )

)


server <- function(input, output, session) {
  my_iris <- reactiveValues(df=iris,sub=NULL, sub1=NULL)

  observeEvent(input$Species, {
    my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
    my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
  }, ignoreNULL = FALSE)
  
  output$iris_datatable <- renderDT({
    n <- length(names(my_iris$sub))
    DT::datatable(my_iris$sub,
                  options = list(pageLength = 10),
                  selection='none', editable= list(target = 'cell'), 
                  rownames= FALSE)
  }, server = FALSE)
  # 
  observeEvent(input$iris_datatable_cell_edit,{
    edit <- input$iris_datatable_cell_edit
    i <- edit$row
    j <- edit$col + 1
    v <- edit$value
    runjs(colorizeCell(i, j+1))
    my_iris$sub[i, j] <<- DT::coerceValue(v, my_iris$sub[i, j])

    my_iris$df <<- rbind(my_iris$sub1,my_iris$sub)
  })
  

  
}
shinyApp(ui, server)

问题分析 #

高亮未生效的核心原因：

1. JS函数中的表格选择器错误：代码里用了#dtable，但实际DT输出的ID是iris_datatable，无法选中目标单元格
2. 列索引计算错误：调用colorizeCell时多算了一次列索引，导致高亮位置偏移
3. 切换Species后高亮丢失：表格重新渲染时，之前的高亮样式会被重置，缺少持久化记录逻辑

修正后的代码 #

library(tidyverse)
library(shiny)
library(DT)
library(shinyjs)
library(jsonlite)

# 修正表格选择器，新增批量高亮函数
js <- HTML(
  "function colorizeCell(i, j){
    var selector = '#iris_datatable tr:nth-child(' + i + ') td:nth-child(' + j + ')';
    $(selector).css({'background-color': 'yellow'});
  }
  function applyHighlights(highlights){
    highlights.forEach(function(item){
      colorizeCell(item.row, item.col);
    });
  }"
)

colorizeCell <- function(i, j){
  sprintf("colorizeCell(%d, %d)", i, j)
}

ui<-fluidPage(  
  useShinyjs(),
  tags$head(tags$script(js)),
  
  sidebarLayout(
    sidebarPanel(width = 3,
                 inputPanel(
                   selectInput("Species", label = "选择物种",
                               choices = levels(as.factor(iris$Species)))
                 )),
    
    mainPanel( 
      tabsetPanel(
        tabPanel("数据表",DTOutput("iris_datatable"), hr())
      )
    )
  )
)


server <- function(input, output, session) {
  my_iris <- reactiveValues(
    df = iris,
    sub = NULL, 
    sub1 = NULL,
    # 记录所有编辑过的单元格信息：物种、子表行号、列号
    edited_cells = list()
  )

  observeEvent(input$Species, {
    my_iris$sub <- my_iris$df %>% filter(Species==input$Species)
    my_iris$sub1 <- my_iris$df %>% filter(Species!=input$Species)
    
    # 切换物种后，对当前子表中已编辑的单元格重新高亮
    current_highlights <- my_iris$edited_cells %>% 
      keep(~ .x$species == input$Species) %>% 
      map(~ list(row = .x$row_in_sub, col = .x$col))
    
    if(length(current_highlights) > 0){
      runjs(sprintf("applyHighlights(%s)", toJSON(current_highlights)))
    }
  }, ignoreNULL = FALSE)
  
  output$iris_datatable <- renderDT({
    DT::datatable(my_iris$sub,
                  options = list(pageLength = 10),
                  selection='none', 
                  editable= list(target = 'cell'), 
                  rownames= FALSE)
  }, server = FALSE)
  
  observeEvent(input$iris_datatable_cell_edit,{
    edit <- input$iris_datatable_cell_edit
    row_idx <- edit$row  # DT行号为1起始
    col_idx <- edit$col + 1  # 转换为1起始列索引
    new_val <- edit$value
    current_species <- input$Species
    
    # 高亮当前编辑单元格
    runjs(colorizeCell(row_idx, col_idx))
    
    # 更新数据
    my_iris$sub[row_idx, col_idx] <- DT::coerceValue(new_val, my_iris$sub[row_idx, col_idx])
    my_iris$df <- rbind(my_iris$sub1, my_iris$sub)
    
    # 去重后记录编辑信息
    my_iris$edited_cells <- my_iris$edited_cells %>% 
      discard(~ .x$species == current_species & .x$row_in_sub == row_idx & .x$col == col_idx)
    
    my_iris$edited_cells <- c(my_iris$edited_cells, list(
      list(species = current_species, row_in_sub = row_idx, col = col_idx)
    ))
  })
}

shinyApp(ui, server)

修正说明 #

1. 修正JS表格选择器为实际DT输出ID#iris_datatable
2. 调整列索引计算逻辑，确保高亮位置准确
3. 新增edited_cells变量持久化记录编辑过的单元格信息，切换物种时自动重新应用高亮
4. 增加批量高亮函数，提升切换物种时的高亮效率

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