R Shiny - Select extension for DataTables - getting selected rows and preselecting rows

问题

The app below has a modal that displays a DT when opened. For the DT, row selection is enabled and I am using the Select extension for DataTables instead of the DT package's implementation of row selection.

The modal has two buttons Apply and Cancel.

When the user clicks Apply, the indices of any rows that they may have selected are stored in a reactive value rv$selected_rows via rv$selected_rows = input$table_rows_selected and the modal is dismissed.
When the user clicks Cancel, any changes that they have made to their selection are discarded by resetting input$table_rows_selected back to rv$selected_rows.

So say the user opens the modal, selects rows 1 and 2 and clicks Apply. If they open the modal again and add row 3 to their selection and then click Cancel, this change should be discarded so that when the modal is reopened, only rows 1 and 2 are selected.

I can reset the value of input$table_rows_selected to rv$selected_cols each time Cancel is clicked using setInputValue (see console for to see how the value changes when Cancel is clicked) but the DT does not rerender to reflect this change even though it is dependent on the value of input$table_rows_selected. I think this is due to the callback that retrieves the selected rows conflicting with the callback used to pre-select rows but can't be sure.

library(DT)
library(shiny)

get_set_rows <- function(idx = NULL) {

  cb = c(
    "var id = $(table.table().node()).closest('.datatables').attr('id');",
    "table.on('click', 'tbody', function(){",
    "  setTimeout(function(){",
    "    var indexes = table.rows({selected:true}).indexes();",
    "    var indices = Array(indexes.length);",
    "    for(var i = 0; i < indices.length; ++i){",
    "      indices[i] = indexes[i] + 1;",
    "    }",
    "    Shiny.setInputValue(id + '_rows_selected', indices);",
    "  }, 0);",
    "});"
  )

  if(!is.null(idx)) {

    cb = c(cb, sprintf('table.rows([%s]).select();', paste(idx - 1, collapse = ','))) #Subtracting 1 since DT uses base indexing

  } else {

    cb = c(cb, 'table.rows().deselect();')

  }

  JS(cb)

}

setInputVal <- function(session, inputId, value) {
  session$sendCustomMessage(type = 'setInputVal', message = list(id = inputId, value = value))
}

shinyApp(
  ui = fluidPage(
    tags$head(tags$script("Shiny.addCustomMessageHandler('setInputVal', function(data) {
  Shiny.setInputValue(data.id, data.value);
});")),
    actionButton('edit', 'Edit'), 
    bsModal(
      id = 'modal', title = 'Title', trigger = 'edit',
      DTOutput('table'),
      actionButton('apply', 'Apply'), 
      actionButton('cancel', 'Cancel')
    )
  ),

  server = function(input, output, session) {  

    rv = reactiveValues(selected_rows =  NULL)

    output$table <- renderDT({

      datatable(
        iris,
        callback = get_set_rows(input$table_rows_selected),
        options = list(select = list(
          style = "multi", 
          selector = "td:not(.notselectable)")),
        extensions = "Select", selection = "none")

    }, server = FALSE)


    observeEvent(input$apply, {

      rv$selected_cols = input$table_rows_selected

      toggleModal(session, 'modal')

      print(paste('rv$selected_cols at Apply:', paste(rv$selected_cols, collapse = ', ')))

    })


    observeEvent(input$cancel, {

      setInputVal(session, 'table_rows_selected', rv$selected_cols)

      toggleModal(session, 'modal')
    })

    observe(print(paste('input$table_rows_selected:', paste(input$table_rows_selected, collapse = ', '))))

  }
)

来源：https://stackoverflow.com/questions/59024766/r-shiny-select-extension-for-datatables-getting-selected-rows-and-preselecti

标签

Shiny