Shiny: keep boxes checked on datatable after changing inputs

Question

I want to implement checkboxes into my shiny app; however, I'm facing two problems:

After I reorder columns, any checks on the datatable disappear (e.g., try to order table by mpg)
After I remove column, any checks on the datatable disappear (e.g., unchecking boxes from Columns to show:)

Here's my dummy example (it's a modified version of code from this SO answer):

library(shiny)
TABLE = mtcars
TABLE$id = 1:nrow(mtcars)
APP <- list()

APP$ui <- pageWithSidebar(
    headerPanel(NULL),
    sidebarPanel(
        checkboxGroupInput("show_vars", "Columns to show:", 
                           names(TABLE), selected = names(TABLE))
    ),
    mainPanel(
        dataTableOutput("resultTABLE")
    )
)
APP$server <- function(input, output, session) {

    output$resultTABLE = renderDataTable({
        addCheckboxButtons <- paste0('<input type="checkbox" name="row', 
                                     TABLE$id, '" value="', TABLE$id, '">',"")
        cbind(Pick = addCheckboxButtons, TABLE[, input$show_vars, drop = FALSE])
    }, escape = FALSE)
}

runApp(APP)

APP works, but for the full implementation I need to solve problems 1 and 2.

Asayat · Accepted Answer · 2017-08-02T07:34:58.140

Based on the SO answer provided in your question:

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))
    ),
    mainPanel(
      dataTableOutput("mytable")
    )
  )
  , server = function(input, output, session) {

    strd<-reactiveValues(tr=0, slrows=character(length=nrow(mymtcars)))


    #preserve selected rows in a reactive element
    rowSelect <- reactive({
      input$rows
    })
    # use reactive value that's equal to 'checked' parameter for html code
    observe({
      strd$slrows<-ifelse(mymtcars$id %in% as.numeric(rowSelect()),'checked','' )
    })

    #use observer for column checkboxinput to detect first run
    observeEvent(input$show_vars, {
      strd$tr<-strd$tr+1
      print(strd$tr)
    }, ignoreNULL = TRUE)


    output$mytable = renderDataTable({
      #if first run - nothing is checked
      if (strd$tr==1){
        addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id, '" >',"")

      } else{
        # add 'checked' parameter for html depending if id is present in selected rows reactive value
        addCheckboxButtons <- paste0('<input type="checkbox" name="row', mymtcars$id, '" value="', mymtcars$id,'" ',
                                     strd$slrows,'>',"")
      }
      #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),
    escape=FALSE, 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); 
    });
  }")
  }
  )
)

Similar, but DT approach: (a bit more efficient as you don't create input for each row and as a consequence it won't recreate table for each reactive values trigger (that's is columns and rows ticks). It recreates table only in column reactive value trigger. You can also use colvis in buttons extension in order to get along with pure DT solution

library(shiny)
library(DT)
mymtcars<-mtcars

shinyApp(
  ui = pageWithSidebar(
    headerPanel('Examples of DataTables'),
    sidebarPanel(
      checkboxGroupInput('show_vars', 'Columns to show:', names(mymtcars),
                         selected = names(mymtcars))
    ),
    mainPanel(
      verbatimTextOutput("selrows"),
      DT::dataTableOutput("mytable")
    )
  ),


  server = function(input, output) {

    strd<-reactiveValues(tr=0, slrows=c(0,0))

    observe({
      if(strd$tr==1){
        strd$slrows<-0
      } else  strd$slrows<-input$mytable_rows_selected
    })

    rowSelect <- reactive({
      input$mytable_rows_selected
    })

    observeEvent(input$show_vars, {
      strd$tr<-strd$tr+1
      print(strd$tr)
    }, ignoreNULL = TRUE)


    output$mytable = DT::renderDataTable({
      datatable(mymtcars[, input$show_vars, drop=F], rownames=FALSE,options = list(pageLength = 10),
                selection = list(mode='multiple', target='row',
                                 selected = strd$slrows)  )

    }
      )

    output$selrows<-renderPrint({
      input$mytable_rows_selected
    })
  }
)

Shiny's DT library has good use of rowselection without checkboxes that might be more useful. You can also use colvis filter through buttons extension, overall the code will be much more efficient, so if having checkboxes is not really compulsory, better to have a look at that. — Asayat, Aug 01 '17 at 07:01
1) small remark: `library(data.table)` should be added. 2) FYI Running your code i get the error: `The 'callback' argument only accept a value returned from JS()`on R 3.4.0, shiny 1.0.3. (Background info: I also worked on this question yesterday and had a pretty similar code without the timeout fct (what fixed the error for me). Last issue was for me, that the table updated the checkboxes and then went back to initial state (so remove the selected ordering),....maybe that is fixed with your data.table approach) — Tonio Liebrand, Aug 01 '17 at 15:52
@BigDataScientist The error occurs if you use DT library. You should detach DT package to run this code. As I mentioned in comments, the code is based on the question code, that is without DT options. However, using DT and it's row selection option would be much more efficient, though maybe it's better to show checkbox for GUI for some reason. — Asayat, Aug 01 '17 at 17:20
To clarify: the JS() function is from DT library and when you add some callback function - all javascript code must be within JS(). In basic shiny datatableOutput you don't use that, there is no JS function() in basic shiny either. — Asayat, Aug 01 '17 at 17:23
interesting. thanks for the hint. What happens for you if you run your first code. Sort the mpg column to "increasing", click the first two checkboxes, switch the sorting to "decreasing" and then back to "increasing"? For me the boxes are not "checked" anymore,... — Tonio Liebrand, Aug 02 '17 at 05:59
@BigDataScientist For me they are checked. The checked values go the middle after sorting though, because you don't undo sorting, but sort other way around. Table refreshes after each reactive trigger, so if you sort by column, check some box, the table will refresh back to it's initial state, but that box will be checked. — Asayat, Aug 02 '17 at 07:33

Shiny: keep boxes checked on datatable after changing inputs

1 Answers1