如何根据复选框输入状态动态更新列值？

Question

我遵循这个问题在DT上注册闪亮的复选框输入值，但我无法弄清楚如何在列

value

中使用文本“包含”表示TRUE和“排除”表示FALSE。

library(shiny)
library(DT)

js <- c(
  "$('[id^=check]').on('click', function(){",
  "  var id = this.getAttribute('id');",
  "  var i = parseInt(/check(\\d+)/.exec(id)[1]);",
  "  var value = $(this).prop('checked');",
  "  var cell = table.cell(i-1, 2).data(value).draw();",
  "})"
)

df <- data.frame(item = c("a", "b", "c"), value = c(TRUE, TRUE, TRUE))

shinyInput <- function(FUN, len, id, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
  }
  inputs
}

## obtaining checkbox value
shinyValue = function(id, len) { 
  unlist(lapply(seq_len(len), function(i) { 
    value = input[[paste0(id, i)]] 
    if (is.null(value)) FALSE else value 
  })) 
} 

shinyCheckboxes <- function(len, id, checked){
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(checkboxInput(paste0(id, i), label=NULL, 
                                            value = checked[i]))
  }
  inputs
}

server <- function(input, output, session) {

  
  output$tbl <- renderDT(server = FALSE, escape = FALSE, editable = TRUE, 
                         callback = JS(js),
                         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()); } ')
                         ), {
                           checked <- sapply(df$value, isTRUE)
                           df$value_check <- shinyCheckboxes(nrow(df), "check", checked)
                           #df$value_check <- shinyInput(checkboxInput, nrow(df), "check")
                           df
                         }
  )
  
  
  observeEvent(input$tbl_rows_selected,{
    print(input$tbl_rows_selected)
  })
}

ui <- fluidPage(
  DTOutput("tbl")
)

shinyApp(ui, server)

所需输出：

我们如何在第

value

栏中使用“包含”表示 TRUE 和“排除”表示 FALSE？

Answer 1

在回调中，将

var value = $(this).prop('checked');

更改为

var value = $(this).prop('checked') ? 'Included': 'Excluded';

。此表示法使用条件（三元）运算符，意味着如果选中该框，则使用“包含”，否则使用“排除”。

您还需要将其包含在初始化表中。下面我通过直接将“包含”定义为列的起始值（之前为

TRUE

）并将

checked

列定义更改为

checked <- sapply(df$value, \(x) x == "Included")

来设置此值。

library(shiny)
library(DT)

js <- c(
  "$('[id^=check]').on('click', function(){",
  "  var id = this.getAttribute('id');",
  "  var i = parseInt(/check(\\d+)/.exec(id)[1]);",
  "  var value = $(this).prop('checked') ? 'Included': 'Excluded';",
  "  var cell = table.cell(i-1, 2).data(value).draw();",
  "})"
)

df <- data.frame(item = c("a", "b", "c"), value = rep('Included', 3))

shinyInput <- function(FUN, len, id, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
  }
  inputs
}

## obtaining checkbox value
shinyValue = function(id, len) { 
  unlist(lapply(seq_len(len), function(i) { 
    value = input[[paste0(id, i)]] 
    if (is.null(value)) FALSE else value 
  })) 
} 

shinyCheckboxes <- function(len, id, checked){
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(checkboxInput(paste0(id, i), label=NULL, 
                                            value = checked[i]))
  }
  inputs
}

server <- function(input, output, session) {
  
  
  output$tbl <- renderDT(server = FALSE, escape = FALSE, editable = TRUE, 
                         callback = JS(js),
                         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()); } ')
                         ), {
                           checked <- sapply(df$value, \(x) x == "Included")
                           df$value_check <- shinyCheckboxes(nrow(df), "check", checked)
                           #df$value_check <- shinyInput(checkboxInput, nrow(df), "check")
                           df
                         }
  )
  
  
  observeEvent(input$tbl_rows_selected,{
    print(input$tbl_rows_selected)
  })
}

ui <- fluidPage(
  DTOutput("tbl")
)

shinyApp(ui, server)