RStudio Shiny list из проверки строк в таблицах данных

Для решения первой проблемы вам потребуется установленная 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); 
    });
}")
  }
  )
)

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

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

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

Я сделал альтернативу для флажков в таблицах на основе предыдущего кода ответа и некоторых настроек 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)
})

Ответы выше устарели. Я получил ошибку Ошибка в таблице данных: аргумент «обратный вызов» принимает только значение, возвращаемое из JS ().

Вместо этого у меня работает Этот.