Embedded selectInput in DT R Shiny with Large Table

Question

I found an extremely helpful answer here that is almost what I need.

This solution of embedding a selectInput in a DataTable works great, but not for those with many rows.

The issue is that the function shinyInput() uses a for loop that can't keep up with tables with rows greater than 1000. It makes the table run far too slowly.

Generating this many input objects takes time. I will need to trigger an SQL UPDATE statement after, but that is another issue.

Is there a way to make this run faster, maybe by generating input objects on the fly as the user clicks through pages?

Another issue is that when the table finally does load with all the embedded objects, if you try to change one of the selectInput's, you will notice that the table takes a long time to catch up.

See this example app:

library(shiny)
library(DT) 

DF = matrix(round(rnorm(1000000, mean = 0, sd = 1), 2), ncol = 50)

runApp(list(
  ui = basicPage(
    h2('A large dataset'),
    DT::dataTableOutput('mytable'),
    h2("Selected"),
    tableOutput("checked")
  ),

  server = function(input, output) {

    # Helper function for making checkbox
    shinyInput = function(FUN, len, id, ...) { 
      inputs = character(len) 
      for (i in seq_len(len)) { 
        inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
        print(i)
      } 
      inputs 
    } 

    # Helper function for reading checkbox
    shinyValue = function(id, len) { 
      unlist(lapply(seq_len(len), function(i) { 
        value = input[[paste0(id, i)]] 
        if (is.null(value)) NA else value 
      })) 
    }

    # Create select input objects to embed in table
    Rating = shinyInput(selectInput,
                        nrow(DF),
                        "selecter_",
                        choices=1:5,
                        width="60px")

    # Data frame to display
    DF_display = data.frame(DF, Rating)

    # Datatable with selectInput
    output$mytable = DT::renderDataTable(
      DF_display,
      selection = 'none',
      server = FALSE,
      escape = FALSE,
      options = list( 
        paging = TRUE,
        pageLength = 20,
        lengthMenu = c(5, 10, 20, 100, 1000, 10000),
        preDrawCallback = JS('function() { 
                             Shiny.unbindAll(this.api().table().node()); }'), 
        drawCallback = JS('function() { 
                          Shiny.bindAll(this.api().table().node()); } '))
    )

    # Read select inputs
    output$checked <- renderTable({
      data.frame(selected = shinyValue("selecter_", nrow(DF)))
    })
    }
))

Ethanol

I have also tried out the shinyValue-function-trick. I hate it. Too unstable. I suggest using the filters which you can slide above your DT table as alternative. I just realised I posted a similar question about this: #47073466 – Gallop

Thank you for your response. My ultimate solution to this, since I posted it a while ago, was to just get away completely from R/Shiny for web app creation. Like you mentioned in your post, there are too many dead ends. It took a while, but eventually I began to bump up against the ceiling of what I was capable to do with Shiny. – Ethanol

so what did you then use instead? I tried bokeh, but it didn't convince me. I think here the limiting factor is the shiny/DT combination. If DT where to be a part of shiny it would be easier. However there are always workarounds: I meant that you use filters like here and then the input$mytable_all_rows- or the input$mytable_selected_rows-property of DT. Alternatively you can subset your table with a dropdown. – Gallop

I realized albeit a little too late that R/Shiny wasn't suitable for my purposes and switched to using Javascript/HTML/CSS for web app development. Workarounds get you almost all the way there, but after I had to work around several things, I decided to just get to the heart of it. – Ethanol

Answer 1

I have once implemented checkboxGroupButtons for an entire column of a data.frame. The following snippet adds such a column to the dataframe df, whereby options are "Aktiv" and "Final":

• "Aktiv" is selected if a[i] == 0
• "Final" is selected if a[i] == 1

Analogously, try out other shiny elements like selectInput().

df <- data.frame(a = c(rep(0,5), rep(1,5))
choices <- c("Aktiv", "Final")
wanted_column <- character(nrow(df))

# add shiny element to the dataframe
for (i in seq_len(nrow(df))) {        
    for (j in seq_len(length(choices))) {
      if (df$a[i] == 0) {
        selected <- choices[0]
      } else {
        selected <- choices[1]
      }
    }
    wanted_column[i] <- as.character(checkboxGroupButtons(
      inputId = paste0("df_checkbox_row_", i),
      label = NULL,
      choices = choices,
      selected = selected,
      justified = TRUE,
      individual = TRUE,
      status = "primary"
    ))
}  
df <- data.frame(df, wanted_column)

#callback for reaction to user-side selections 
callbackId <- "dt_checkbox_event"
column <- 2
callback <- c(
  paste0("table.on('change.dt', 'td:nth-child(", column, ")', function() {"),
  "var row_ = table.cell(this).index().row + 1;",
  "var col = table.cell(this).index().column;",
  "var checkboxesName = 'df_checkbox_row_' + row_",
  "var checkboxes = document.getElementsByName(checkboxesName)",
  "var checkedStatuses = []",
  "checkboxes.forEach(myfunc)",
  "function myfunc(item) {",
  "    if (item.checked) {",
  "       checkedStatuses.push(item.value);",
  "    }",
  "}",
  "var data = [row_, col, checkedStatuses];",
  paste0("Shiny.onInputChange('", callbackId, "',data);"),
  "});"
)


dt <- data.table(df,
                 escape = FALSE, #to enable HTML within the datatable
                 selection = "none",
                 callback = JS(callback))

Even if the question was posted years ago, it maybe still helps someone.

Infinitesimal