Shiny - checkboxInput внутри renderDataTable не работает

Question

Я хочу отобразить таблицу в Shiny с функцией renderDataTable (). Для каждой строки я хочу создать 2 флажка. Я использую функцию checkboxInput () для создания этих флажков. Флажки созданы, но когда я пытаюсь прочитать их с помощью ввода $ checkbox_id, я получаю NULL.

Тот же трюк работает с использованием renderTable (), но мой клиент хочет дополнительные функции таблицы DT (сортировка, фильтрация).

Если я проверяю сгенерированный HTML-код, я вижу, что renderTable () вставляет и дополнительный class = "transparent-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 в консоли. ЛОЖЬ правильно, потому что второй флажок снят. Я получаю NULL, потому что входной $ id_1 не существует в сеансе сервера Shiny. Я ожидаю FALSE и FALSE в журнале консоли.

Answer 1

Вы можете использовать пакет DT (на основе this ):

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)})
    }
)