如何在DT表格中创建互相关联的复选框列？

在DT表格中实现included和excluded两个复选框列，需满足以下规则：

• 当用户勾选included（设为TRUE）时，excluded自动取消勾选（设为FALSE）；
• 当用户取消勾选included（设为FALSE）时，excluded自动勾选（设为TRUE）；
• 允许两者同时为未勾选状态（均为FALSE），但禁止同时为勾选状态（均为TRUE）。

现有代码无法实现上述联动逻辑，代码如下：

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
    df = data.frame(
      included = shinyInput(checkboxInput, n, 'in_', value = TRUE, width='1px'),
      excluded = shinyInput(checkboxInput, n, 'ex_', value = FALSE, width='1px'),
      ID = seq_len(n),
      stringsAsFactors = FALSE)
    
    loopData = reactive({
      df$included  <<- shinyInput(checkboxInput, n, 'in_', value = shinyValue('in_', n), width='1px')
      df$excluded <<- shinyInput(checkboxInput, n, 'ex_', value = FALSE, width='1px')
      df
    })
    
    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)
    })
    
    output$x2 = renderPrint({
      data.frame(Inclusion = shinyValue('in_', n),
                 Exclusion = shinyValue('ex_', n))
    })
  }
)

通过添加状态监听和输入更新逻辑，实现复选框的联动，修改后的完整代码如下：

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
    
    # 用reactiveVal存储当前复选框状态，避免全局变量修改
    state <- reactiveVal(data.frame(
      included = rep(TRUE, n),
      excluded = rep(FALSE, n),
      ID = seq_len(n)
    ))
    
    # 生成表格数据的reactive函数
    loopData <- reactive({
      current_state <- state()
      data.frame(
        included = shinyInput(checkboxInput, n, 'in_', value = current_state$included, width='1px'),
        excluded = shinyInput(checkboxInput, n, 'ex_', value = current_state$excluded, width='1px'),
        ID = seq_len(n),
        stringsAsFactors = FALSE
      )
    })
    
    # 监听included复选框的变化，联动更新excluded
    observe({
      for(i in seq_len(n)){
        observeEvent(input[[paste0("in_", i)]], {
          current <- state()
          if(input[[paste0("in_", i)]] == TRUE){
            current$excluded[i] <- FALSE
            updateCheckboxInput(session, paste0("ex_", i), value = FALSE)
          } else {
            current$excluded[i] <- TRUE
            updateCheckboxInput(session, paste0("ex_", i), value = TRUE)
          }
          state(current)
        }, ignoreInit = TRUE)
      }
    })
    
    # 监听excluded复选框的变化，确保不能同时为TRUE
    observe({
      for(i in seq_len(n)){
        observeEvent(input[[paste0("ex_", i)]], {
          current <- state()
          if(input[[paste0("ex_", i)]] == TRUE && current$included[i] == TRUE){
            current$included[i] <- FALSE
            updateCheckboxInput(session, paste0("in_", i), value = FALSE)
          }
          state(current)
        }, ignoreInit = TRUE)
      }
    })
    
    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)
    })
    
    output$x2 = renderPrint({
      data.frame(Inclusion = shinyValue('in_', n),
                 Exclusion = shinyValue('ex_', n))
    })
  }
)

关键修改说明 #

1. 使用reactiveVal存储复选框状态，替代全局变量修改，确保状态管理更规范；
2. 添加两个观察者：
   • 监听included的变化，根据其值自动更新对应的excluded复选框；
   • 监听excluded的变化，若用户勾选excluded时included处于勾选状态，自动取消included的勾选，避免同时为TRUE；
3. 调整loopData逻辑，基于当前状态生成表格，确保显示与实际状态一致。

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