R shiny: update select input values in data.table

Question

I have renderDataTable with select Inputs and buttons inside. I want to update selectInput inside datatable after click on 'Save' button in appropriate row. How can I do that? During searching for a solution I found that "if you rerender the table, the inputs won't work unless you add some extra code to unbind". However I am new in shiny and using js options, so I would be grateful for any hints/solutions.

library(shiny)
library(DT) 
runApp(list(
  ui = basicPage(
    h2('The mtcars data'),
    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), ...)) 
      } 
      inputs 
    } 
    # datatable with checkbox
    output$mytable = DT::renderDataTable({
      data.frame(mtcars,Rating=shinyInput(selectInput,nrow(mtcars),"selecter_",label=NULL,
                                          choices=1:5, width="60px"),
                 Save = shinyInput(actionButton, nrow(mtcars),'button_', 
                                         label = 'Save',onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ))
    }, selection='none',server = FALSE, escape = FALSE, options = list( 
      paging=TRUE,
      preDrawCallback = JS('function() { 
                           Shiny.unbindAll(this.api().table().node()); }'), 
      drawCallback = JS('function() { 
                        Shiny.bindAll(this.api().table().node()); } ') 
      ) )
    # 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 
      })) 
    } 
    # output read checkboxes
    output$checked <- renderTable({
      data.frame(selected=shinyValue("selecter_",nrow(mtcars)))
    })
    }
))

Gouda

You are using data.frame, not data.table. Function DT::renderDataTable refers to DataTables javascript library. I've fixed your tags. – Leapfrog

What do you mean by do not render properly? – Lipography

I added action button 'Save', after click on a button I want to update all selectInput buttons inside data.table, however none of them updates. During searching for update inputs in renderDataTable, I found that 'if you rerender the table, the inputs won't work unless you add some extra code to unbind'. I have no idea what 'extra code to unbind' means. – Gouda

I updated my question to better understanding of my issue. – Gouda

Answer 1

Hey so I don't completely understand your question, but hopefully this helps. This app isn't perfect, but should do what you want:

library(shiny)
library(DT)
runApp(list(
  ui = basicPage(
    tags$script(
      HTML(
        "Shiny.addCustomMessageHandler('unbind-DT', function(id) {
        Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
        })"
)
    ),
h2('The data'),
selectInput("myData", "Choose dataset", c("mtcars", "iris"), "mtcars"),
DT::dataTableOutput('mytable'),
h2("Selected"),
tableOutput("checked")
      ),

server = function(input, output, session) {
  dataset <- reactive({
    session$sendCustomMessage("unbind-DT", "mytable")
    get(input$myData)
  })

  # 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), ...))
    }
    inputs
  }
  # datatable with checkbox
  output$mytable = DT::renderDataTable({
    data.frame(
      dataset(),
      Rating = shinyInput(
        selectInput,
        nrow(dataset()),
        "selecter_",
        choices = 1:5,
        width = "60px",
        label = NULL
      ),
      Save = shinyInput(actionButton, nrow(dataset()), 'button_',
                        label = 'Save')
    )
  }, selection = 'none', server = FALSE, escape = FALSE, options = list(
    dom = "ti",
    paging = TRUE,
    preDrawCallback = JS(
      'function() {
      Shiny.unbindAll(this.api().table().node()); }'
    ),
    drawCallback = JS('function() {
                      Shiny.bindAll(this.api().table().node()); } ')
    ))
  # 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
    }))
  }
  # output read checkboxes
  output$checked <- renderTable({
    data.frame(selected = shinyValue("selecter_", nrow(mtcars)))
  })

  lapply(1:150, function(i) {
    observeEvent(input[[paste0("button_", i)]], {
      updateSelectInput(session,
                        paste0("selecter_", i),
                        selected = 5,
                        label = NULL)
    })
  })

}

))

Wizened

it does not update with last selected value in given row. – Gouda

Hi all involved, I have a similar question, wonder if you can take a look? Thanks – Ladonnalady