RStudio Shiny list from checking rows in dataTables

Question

I would like to have a working example similar to this: https://demo.shinyapps.io/029-row-selection/

I tried the example in my Shiny server running Shiny Server v1.1.0.10000, packageVersion: 0.10.0 and Node.js v0.10.21, but it is not working even if I load the js and css files from the website. It simply does not select rows from the table:

# ui.R
library(shiny)

shinyUI(fluidPage(
  title = 'Row selection in DataTables',
  tagList(
          singleton(tags$head(tags$script(src='//cdn.datatables.net/1.10.2/js/jquery.dataTables.js',type='text/javascript'))),
          singleton(tags$head(tags$script(src='//cdn.datatables.net/1.10.2/css/jquery.dataTables.min.css',type='text/css')))
        ),
  sidebarLayout(
    sidebarPanel(textOutput('rows_out')),
    mainPanel(dataTableOutput('tbl')),
    position = 'right'
  )
))

# server.R
library(shiny)

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

I then tried to do this from a different example that was using radio buttons to re-sort the rows.

In my modified example, I want to produce a list of ids from the selected checkbox buttons of the dataTables table shown in the webpage. E.g., selecting some rows from the first 5, I want my textbox to be: 1,3,4 corresponding to the mymtcars$id column I added to mtcars. I then plan to link an action to the values of the textbox.

I have it almost there in this example, but checking the boxes does not update the list in the textbox. Differently to the example shinyapp, I would like my checkboxes to keep the selection status if the table is resorted. This may be the tricky part, and I am not sure how to do it. I would also like to add a "Select/Unselect all" textbox on the top left corner of the table, that selects/unselects all boxes in the table. Any ideas?

# server.R
library(shiny)

mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)

shinyServer(function(input, output, session) {

      rowSelect <- reactive({
        if (is.null(input[["row"]])) {
            paste(sort(unique(rep(0,nrow(mymtcars)))),sep=',')
        } else {
            paste(sort(unique(input[["row"]])),sep=',')
        }
      })

  observe({
      updateTextInput(session, "collection_txt",
        value = rowSelect()
        ,label = "Foo:"
      )
  })

      # sorted columns are colored now because CSS are attached to them
      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(bSortClasses = TRUE, aLengthMenu = c(5, 25, 50), iDisplayLength = 25))

})


# ui.R
library(shiny)

mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)

shinyUI(pageWithSidebar(
      headerPanel('Examples of DataTables'),
      sidebarPanel(
              checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
                                                        selected = names(mymtcars))
            ),
      mainPanel(
                         dataTableOutput("mytable")
      ,textInput("collection_txt",label="Foo")
              )
      )
)

Answer 1

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

for your second example:

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

Answer 2

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().