如何在DT表格中实现多列互相关联复选框？新增列后失效求解

你的代码核心问题在于每次操作某一行的复选框时，会错误地更新所有行的复选框状态，同时逻辑上违反了规则1（当included为TRUE时，其他两列必须为FALSE）。例如：

• 当你将某行的excluded从TRUE改为FALSE时，原代码会将所有行的included设为!excluded，导致其他行可能出现included=TRUE且filter=TRUE的冲突情况；
• 操作filter列时也会出现类似的逻辑冲突。

此外，原代码使用全局变量修改（<<-）不符合Shiny反应式编程的最佳实践，容易引发不可预期的状态变化。

我们调整了逻辑，确保仅修改当前操作行的状态，同时严格遵循你提出的三条规则：

library(shiny)
library(DT)

shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('x1'),
    verbatimTextOutput('x2')
  ),
  
  server = function(input, output, session) {
    # 创建Shiny输入的工具函数
    shinyInput = function(FUN, len, id, value, ...) {
      if (length(value) == 1) value <- rep(value, len)
      inputs = character(len)
      for (i in seq_len(len)) {
        inputs[i] = as.character(FUN(paste0(id, i), label = NULL, value = value[i]))
      }
      inputs
    }
    
    # 获取输入值的工具函数
    shinyValue = function(id, len) {
      unlist(lapply(seq_len(len), function(i) {
        value = input[[paste0(id, i)]]
        if (is.null(value)) TRUE else value
      }))
    }
    
    n = 6
    # 初始化复选框状态
    checkBoxValues <- reactiveVal(
      data.frame(ins = rep(TRUE, n), exs = rep(FALSE, n), filters = rep(FALSE, n))
    )
    
    # 生成DT表格数据（避免修改全局变量）
    loopData = reactive({
      current_vals <- checkBoxValues()
      data.frame(
        included = shinyInput(checkboxInput, n, 'in_', value = current_vals$ins, width='1px'),
        excluded = shinyInput(checkboxInput, n, 'ex_', value = current_vals$exs, width='1px'),
        Not_filter = shinyInput(checkboxInput, n, 'filter_', value = current_vals$filters, width='1px'),
        ID = seq_len(n),
        stringsAsFactors = FALSE
      )
    })
    
    output$x1 = DT::renderDataTable(
      isolate(loopData()),
      escape = FALSE, selection = 'none',
      options = list(
        dom = 't', paging = FALSE, ordering = FALSE,
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      ))
    
    proxy = dataTableProxy('x1')
    
    observe({
      replaceData(proxy, loopData(), resetPaging = FALSE)
    })
    
    # 处理included列的复选框事件
    lapply(1:n, function(x) {
      observeEvent(input[[paste0("in_", x)]], {
        current_vals <- checkBoxValues()
        current_vals$ins[x] <- input[[paste0("in_", x)]]
        
        # 应用规则1和规则2
        if (current_vals$ins[x]) {
          # included为TRUE时，其他两列设为FALSE
          current_vals$exs[x] <- FALSE
          current_vals$filters[x] <- FALSE
        } else {
          # included为FALSE时，其他两列设为TRUE
          current_vals$exs[x] <- TRUE
          current_vals$filters[x] <- TRUE
        }
        
        checkBoxValues(current_vals)
      }, ignoreInit = TRUE)
    })
    
    # 处理filter列的复选框事件
    lapply(1:n, function(x) {
      observeEvent(input[[paste0("filter_", x)]], {
        current_vals <- checkBoxValues()
        current_vals$filters[x] <- input[[paste0("filter_", x)]]
        
        # 确保规则1：included为TRUE时，filter不能为TRUE
        if (current_vals$ins[x] && current_vals$filters[x]) {
          current_vals$ins[x] <- FALSE
        }
        
        # 确保规则3：不允许全TRUE
        if (current_vals$ins[x] && current_vals$exs[x] && current_vals$filters[x]) {
          current_vals$ins[x] <- FALSE
        }
        
        checkBoxValues(current_vals)
      }, ignoreInit = TRUE)
    })
    
    # 处理excluded列的复选框事件
    lapply(1:n, function(x) {
      observeEvent(input[[paste0("ex_", x)]], {
        current_vals <- checkBoxValues()
        current_vals$exs[x] <- input[[paste0("ex_", x)]]
        
        # 确保规则1：included为TRUE时，excluded不能为TRUE
        if (current_vals$ins[x] && current_vals$exs[x]) {
          current_vals$ins[x] <- FALSE
        }
        
        # 确保规则3：不允许全TRUE
        if (current_vals$ins[x] && current_vals$exs[x] && current_vals$filters[x]) {
          current_vals$ins[x] <- FALSE
        }
        
        checkBoxValues(current_vals)
      }, ignoreInit = TRUE)
    })
    
    output$x2 = renderPrint({
      data.frame(
        Inclusion = shinyValue('in_', n),
        Exclusion = shinyValue('ex_', n),
        NotFilter = shinyValue('filter_', n)
      )
    })
  }
)

1. 仅修改当前操作行：每个observeEvent仅更新触发事件的那一行的状态，其他行保持原有值，避免全局修改引发的冲突；
2. 严格遵循规则：
   • 勾选included=TRUE时，强制将该行excluded和filter设为FALSE；
   • 勾选included=FALSE时，自动将该行excluded和filter设为TRUE；
   • 操作excluded或filter时，自动检查并修正违反规则1和规则3的情况；
3. 移除全局变量修改：loopData每次生成新的data.frame，避免使用<<-修改全局状态，符合Shiny的反应式编程规范。

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