RStudio Shiny список из проверки строк в dataTables

Ответ 1

Для первой проблемы вам понадобится версия dev shiny и htmltools >= 0.2.6:

# devtools::install_github("rstudio/htmltools")
# devtools::install_github("rstudio/shiny")
library(shiny)
runApp(list(ui = fluidPage(
  title = 'Row selection in DataTables',
  sidebarLayout(
    sidebarPanel(textOutput('rows_out')),
    mainPanel(dataTableOutput('tbl')),
    position = 'right'
  )
)
, server = function(input, output) {
  output$tbl <- renderDataTable(
    mtcars,
    options = list(pageLength = 10),
    callback = "function(table) {
    table.on('click.dt', 'tr', function() {
    $(this).toggleClass('selected');
    Shiny.onInputChange('rows',
    table.rows('.selected').indexes().toArray());
    });
}"
  )
  output$rows_out <- renderText({
    paste(c('You selected these rows on the page:', input$rows),
          collapse = ' ')
  })
}
)
)

для вашего второго примера:

library(shiny)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(
  list(ui = pageWithSidebar(
    headerPanel('Examples of DataTables'),
    sidebarPanel(
      checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
                         selected = names(mymtcars))
      ,textInput("collection_txt",label="Foo")
    ),
    mainPanel(
      dataTableOutput("mytable")
    )
  )
  , server = function(input, output, session) {
    rowSelect <- reactive({
      paste(sort(unique(input[["rows"]])),sep=',')
    })
    observe({
      updateTextInput(session, "collection_txt", value = rowSelect() ,label = "Foo:" )
    })
    output$mytable = renderDataTable({
      addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '">',"")
      #Display table with checkbox buttons
      cbind(Pick=addCheckboxButtons, mymtcars[, input$show_vars, drop=FALSE])
    }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25)
    , callback = "function(table) {
    table.on('change.dt', 'tr td input:checkbox', function() {
      setTimeout(function () {
         Shiny.onInputChange('rows', $(this).add('tr td input:checkbox:checked').parent().siblings(':last-child').map(function() {
                 return $(this).text();
              }).get())
         }, 10); 
    });
}")
  }
  )
)

Ответ 2

Этот ответ оказался сломанным в блестящем 0.11.1, но его можно легко устранить. Вот обновление, которое сделало это (ссылка):

Добавлен аргумент escape в renderDataTable(), чтобы избежать элементов HTML   в таблице данных по соображениям безопасности. Это может привести к поломке таблиц с предыдущих   версии блестящих, которые используют исходный HTML в содержимом таблицы, а также старое поведение   может быть возвращено escape = FALSE, если вы знаете о безопасности   последствия. (# 627)

Таким образом, чтобы предыдущие решения работали, нужно указать escape = FALSE как опцию renderDataTable().

Ответ 3

Я сделал альтернативу для флажков в таблицах на основе предыдущего кода ответа и некоторой настройки JQuery/JavaScript.

Для тех, кто предпочитает фактические данные по номерам строк, я написал этот код, который извлекает данные из таблицы и показывает это как выбор. Вы можете отменить выбор, щелкнув еще раз. Он основывается на первых ответах, которые мне очень помогли (СПАСИБО), поэтому я хочу поделиться этим также.

Ему нужен объект сеанса, чтобы сохранить вектор (область охвата). Фактически вы можете получить любую необходимую информацию из таблицы, просто погрузитесь в JQuery и измените строку $row.find('td: nth-child (2)') (число - номер столбца). Мне нужна информация со второго но это зависит от вас. Цвета выбора немного нечетны, если вы также меняете количество видимых столбцов... цвета выбора, как правило, исчезают...

Надеюсь, это полезно, работает для меня (нужно оптимизировать, но сейчас нет времени)

output$tbl <- renderDataTable(
  mtcars,
  options = list(pageLength = 6),
  callback = "function(table) {
  table.on('click.dt', 'tr', function() {

  if ( $(this).hasClass('selected') ) {
    $(this).removeClass('selected');
  } else {
    table.$('tr.selected').removeClass('selected');
    $(this).addClass('selected');
  }

  var $row = $(this).closest('tr'),       
    $tdsROW = $row.find('td'),
    $tdsUSER = $row.find('td:nth-child(2)');

  $.each($tdsROW, function() {               
    console.log($(this).text());        
  });

  Shiny.onInputChange('rows',table.rows('.selected').indexes().toArray());
  Shiny.onInputChange('CELLselected',$tdsUSER.text());
  Shiny.onInputChange('ROWselected',$(this).text());

  });
  }"
)

output$rows_out <- renderUI({
  infoROW <- input$rows
  if(length(input$CELLselected)>0){
    if(input$CELLselected %in%  session$SelectedCell){
      session$SelectedCell <- session$SelectedCell[session$SelectedCell != input$CELLselected]
    }else{
      session$SelectedCell <- append(session$SelectedCell,input$CELLselected)
    }
  }
  htmlTXT <- ""
  if(length(session$SelectedCell)>0){
    for(i in 1:length(session$SelectedCell)){
      htmlTXT <- paste(htmlTXT,session$SelectedCell[i],sep="<br/>")
    }
  }else{htmlTXT <- "please select from the table"}
  HTML(htmlTXT)
})