閃亮-renderDataTable中的checkboxInput不起作用

Question

我想用renderDataTable（）函數在Shiny中顯示一個表。 我想為每一行創建2個復選框。 我正在使用checkboxInput（）函數創建這些復選框。 復選框已創建，但是當我嘗試使用input $ checkbox_id讀取它們時，我得到NULL。

使用renderTable（）可以實現相同的技巧，但是我的客戶希望使用DT表的其他功能（排序，過濾）。

如果檢查生成的HTML，我會看到renderTable（）插入了額外的class =“ shiny-bound-input”到標記中。 renderDataTable（）沒有。

library(shiny)
shinyApp(
    ui = fluidPage(
       fluidRow(
         column(12,dataTableOutput('dataTableOutput')),
         column(12,tableOutput('tableOutput')),
         actionButton('printCheckStatus','printCheckStatus')
       )
     ),
     server = function(input, output) {
       df1 <- data.frame(CheckBoxColumn=as.character(checkboxInput("id_1",NULL)))
       df2 <- data.frame(CheckBoxColumn=as.character(checkboxInput("id_2",NULL)))
       output$dataTableOutput <- renderDataTable(df1,escape = FALSE)
       output$tableOutput <- renderTable(df2, sanitize.text.function = function(x) x)

       observeEvent(input$printCheckStatus, {print(input$id_1);print(input$id_2)})
     }
)

該代碼生成一個按鈕和兩個表，每個表包含一個復選框。 當我單擊按鈕時，控制台中顯示NULL和FALSE。 FALSE是正確的，因為未選中第二個復選框。 我得到NULL，因為Shiny服務器會話中不存在input $ id_1。 我希望控制台日志中為FALSE和FALSE。

Answer 1

您可以使用DT包（基於此 ）：

library(shiny)
library(DT)
shinyApp(
    ui = fluidPage(
        fluidRow(
            column(12,dataTableOutput('dataTableOutput')),
            column(12,tableOutput('tableOutput')),
            actionButton('printCheckStatus','printCheckStatus')
        )
    ),
    server = function(input, output) {
        df1 <- data.frame(CheckBoxColumn=as.character(checkboxInput("id_1",NULL)))
        df2 <- data.frame(CheckBoxColumn=as.character(checkboxInput("id_2",NULL)))
        output$dataTableOutput <- renderDataTable(df1,escape = FALSE, server = FALSE, 
        callback = JS("table.cells().every(function(i, tab, cell) {
          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());"))
        output$tableOutput <- renderTable(df2, sanitize.text.function = function(x) x)

        observeEvent(input$printCheckStatus, {print(input$id_1);print(input$id_2)})
    }
)