如何给DT复选框赋值？

Question

可以在

TRUE

应用程序中通过 javascript 为输入类型复选框分配值

FALSE

/

shiny

吗？例如，我有一个反应式数据表：

data:vals<-reactiveValues()
  vals$Data<-data.table(
    Brands=paste0("Brand",1:200000),
    Forecasted_Growth=sample(1:200000,200000),
    Last_Year_Purchase=round(rnorm(200000,1000,1000)^2),
    Contact=paste0("Brand",1:200000,"@email.com"),
    YN=sample(rep(c("TRUE","FALSE"),each=100000),200000,replace=FALSE)
  )

我想在应用程序加载时将每个 YN 的值分配给一个复选框。稍后我可以操作选中的行。 我尝试像这样使用

HTML

将每个 YN 的值分配给每个复选框，但它不起作用：

DT[["Select"]]<-paste0('<input type="checkbox" name="row_selected',1:nrow(vals$Data),'" value=',vals$Data$YN,'><br>')

然后我会用这个JS来获取值：

tags$script(HTML('$(document).on("click", "input", function () {
  var checkboxes = document.getElementsByName("row_selected");
  var checkboxesChecked = [];
  for (var i=0; i<checkboxes.length; i++) {

     if (checkboxes[i].checked) {
        checkboxesChecked.push(checkboxes[i].value);
     }
  }
  Shiny.onInputChange("checked_rows",checkboxesChecked);
      })')),

是否可以通过这种方式为复选框赋值？我正在尝试修改这里的示例：

https://github.com/AntoineGuillot2/ButtonsInDataTable/

Answer 1

您的方法不起作用的原因是您将

YN

表示的布尔值分配给

value

属性。相反（对于

HTML 5

），如果

checked

，则必须使用

TRUE

，否则省略

checked

。

因此，示例

df

可能如下所示：

> df
                                           Select    YN  mpg cyl disp  hp
Mazda RX4         <input type="checkbox" checked>  TRUE 21.0   6  160 110
Mazda RX4 Wag            <input type="checkbox" > FALSE 21.0   6  160 110
Datsun 710        <input type="checkbox" checked>  TRUE 22.8   4  108  93
Hornet 4 Drive    <input type="checkbox" checked>  TRUE 21.4   6  258 110
Hornet Sportabout        <input type="checkbox" > FALSE 18.7   8  360 175

当应用程序启动时，它看起来像这样：

最小示例：

library(shiny)
library(DT)
library(dplyr)

df <- head(mtcars[1:4], n = 5) |>
  mutate(YN = c(T, F, T, T, F), .before = mpg) |>
  mutate(Select = paste0('<input type="checkbox" ',
                         ifelse(YN == TRUE, 'checked', ''),
                         '>'),
         .before = YN)

js <- c(
  "table.rows().every(function(i, tab, row) {",
  "    var $this = $(this.node());",
  "    $this.attr('id', this.data()[0]);",
  "    $this.addClass('shiny-input-checkbox');",
  "});",
  "Shiny.unbindAll(table.table().node());",
  "Shiny.bindAll(table.table().node());"
)

ui <- fluidPage(DT::dataTableOutput("example"))

server <- function(input, output, session) {
  rv <- reactiveValues(df = df)
  
  output$example <- DT::renderDataTable(rv$df,
                                        callback = JS(js),
                                        escape = FALSE,
                                        server = FALSE)
}

shinyApp(ui, server)