Получить выбранные столбцы в таблице DT

Question

Я разрабатываю блестящее приложение, в котором пользователь может выбрать несколько столбцов в большом наборе данных, чтобы создать подмножество этого набора данных. Я использую пакет DT, чтобы красиво отобразить таблицу в блестящем приложении.

Ранее я использовал версию 0.2 пакета DT, где работал следующий код:

library("DT")
library("shiny")

ui <- fluidPage(
  DT::dataTableOutput('table1'),
  DT::dataTableOutput("table2")
)

server <- function(input, output) {
  output$table1 <- DT::renderDataTable({
    datatable(mtcars, extensions = 'Select', selection = 'none', options = list(ordering = FALSE, searching = FALSE, pageLength = 25, select = list(style = 'os', items = 'column')),
              callback = JS(
                "table.on( 'click.dt', 'tbody td', function (e) {",
                "var type = table.select.items();",
                "var idx = table[type + 's']({selected: true}).indexes().toArray();",
                "var DT_id = table.table().container().parentNode.id;",
                "Shiny.onInputChange(DT_id + '_columns_selected', idx);",
                "})"
              ))
  })

  output$table2 <- DT::renderDataTable({
    subset_table <- mtcars[,input$table1_columns_selected]
    datatable(subset_table)
  })
}

shinyApp(ui = ui, server = server)

К сожалению, этот код больше не работает (я сейчас под версией 0.4). input$table1_columns_selected не отображает индексы выбранных столбцов. Согласно этому https://rstudio.github.io/DT/shiny.html теперь есть функциональность для выбора нескольких строк, но я не могу понять, как сделать то же самое со столбцами.

Любая идея? Большое спасибо за Вашу помощь!

Answer 1

Я не уверен, почему вам нужно использовать аргумент обратного вызова, чтобы сделать это. Вот упрощенный подход -

library("DT")
library("shiny")

ui <- fluidPage(
  DT::dataTableOutput('table1'),
  DT::dataTableOutput("table2")
)

server <- function(input, output) {
  output$table1 <- DT::renderDataTable({
    datatable(mtcars, extensions = 'Select', selection = list(target = "column"), options = list(ordering = FALSE, searching = FALSE, pageLength = 25))
  })

  output$table2 <- DT::renderDataTable({
    subset_table <- mtcars[, input$table1_columns_selected, drop = F]
    datatable(subset_table)
  })
}

shinyApp(ui = ui, server = server)

Обратите внимание на изменение в datatable аргументы в output$table1, Надеюсь, это то, что вы искали.

Answer 2

Я проверил ваш код и он работает нормально для меня (см. Рисунок ниже), и я также использую версию DT пакета 0.4.

Поэтому я предполагаю, что проблема связана не с DT-пакетом, а с чем-то другим в вашей глобальной конфигурации.