RStudio Shiny list from checking rows in dataTables RStudio Shiny list from checking rows in dataTables r r

RStudio Shiny list from checking rows in dataTables


For the first problem you need the dev version of shiny and htmltools >= 0.2.6 installed:

# 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 = ' ')  })}))

enter image description here

for your second example:

library(shiny)mymtcars = mtcarsmymtcars$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);     });}")  }  ))

enter image description here


This answer has been rendered broken in shiny 0.11.1, but can easily be fixed. Here is the update that did it (link):

Added an escape argument to renderDataTable() to escape the HTML entities in the data table for security reasons. This might break tables from previous versions of shiny that use raw HTML in the table content, and the old behavior can be brought back by escape = FALSE if you are aware of the security implications. (#627)

Thus, to make the previous solutions work, one must specify escape = FALSE as an option to renderDataTable().


I have made an alternative for check boxes in tables based on the previous Answer code and some tweaking of the JQuery / JavaScript.

For anyone who prefers actual data over row numbers i wrote this code that extracts data from the table and shows that as selection. You can deselect by clicking again. It builds on the former Answers that were very helpful to me (THANKS) so i want to share this as well.

It needs a session object to keep the vector alive (scoping). Actually you can get whatever information you want from the table, just dive into JQuery and change the $row.find('td:nth-child(2)') (number is the column number).I needed the info from the Second column but it is up to you. Selection colors is a bit odd if you also change the visible column amount.... selection colors tend to disappear...

I hope this is helpful, works for me (needs to be optimized but no time for that now)

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