CODEWITHSUNDEEP
rshinydt
Tom
Tom

Reputation: 602

Why do R/Shiny inputs in datatable not work correctly after updating datatable?

I'm trying to create a datatable with Shiny input elements (checkboxInput or textInput). This works well until I update the datatable. If I add more rows with more input elements, only the new elements work. I thought the table would be recreated every time I update it and the ids would be associated with the new input elements. The code example below illustrates the problem. It creates a table with one row first. If I then create a table with two rows using the dropdown on the left, I can only read the values of the second row in the output table. Any change to the inputs of the first row has no impact on the ouput table.

library(DT)
library(shiny)
server <- function(input, output) {
  updateTable <- reactive({
    num <- as.integer(input$num)
    df <- data.frame(check = unlist(lapply(1:num, function(i) as.character(checkboxInput(paste0("check_", i), label = paste0("check", i), value = 0)))),
               text = unlist(lapply(1:num, function(i) as.character(textInput(paste0("text_",i), label = paste0("text", i), value = "")))))
  })

  output$input_ui <- DT::renderDataTable(
    updateTable(),
    server = FALSE, escape = FALSE, selection = 'none',
    options = list(
      dom = 't', paging = FALSE, ordering = FALSE,lengthChange = TRUE,
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
    )
  )

  output$table <- renderTable({
    num <- as.integer(input$num)
    data.frame(lapply(1:num, function(i) {
      paste(input[[paste0("check_", i)]], input[[paste0("text_",i)]], sep = " : ")
    }))
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("num", "select number of inputs", choices = seq(1,10,1))
    ),
    mainPanel(
      DT::dataTableOutput("input_ui"),
      tableOutput("table")
    )
  )
)

shinyApp(ui = ui, server = server)

Upvotes: 2

Views: 1308

Answers (1)

lbusett
lbusett

Reputation: 5932

A possible solution is provided here:

https://groups.google.com/d/msg/shiny-discuss/ZUMBGGl1sss/7sdRQecLBAAJ

As far as I understand, it allows to "force" a complete unbind of all checkbox/textinpts before redrawing the table thanks to the use of: 

session$sendCustomMessage('unbind-DT', 'input_ui')

. I do not pretend to really understsand it, but apparently it works. See below for a possible implementation. 

library(shiny)
library(DT)
server <- function(input, output,session) {
  updateTable <- reactive({
    num <- as.integer(input$num)
    session$sendCustomMessage('unbind-DT', 'input_ui')
    df <- data.frame(
      check = unlist(lapply(1:num, function(i) as.character(checkboxInput(paste0("check_", i), label = paste0("check", i), value = 0)))),
      text = unlist(lapply(1:num, function(i) as.character(textInput(paste0("text_",i), label = paste0("text", i), value = "")))))
    tbl <- DT::datatable(df, escape = FALSE,
                         selection = "none", 
                         options = list(
                           dom = 't', paging = FALSE, ordering = FALSE,lengthChange = TRUE,
                           preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                           drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                         ))

  })

  output$input_ui <- DT::renderDataTable(
    updateTable(),
    server = FALSE
  )

  output$table <- renderTable({
    num <- as.integer(input$num)
    data.frame(lapply(1:num, function(i) {
      paste(input[[paste0("check_", i)]], input[[paste0("text_",i)]], sep = " : ")
    }))
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("num", "select number of inputs", choices = seq(1,10,1))
    ),
    mainPanel(
      DT::dataTableOutput("input_ui"),
      tags$script(HTML(
        "Shiny.addCustomMessageHandler('unbind-DT', function(id) {
          Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
        })")),
      tableOutput("table")
    )
  )
)

shinyApp(ui = ui, server = server)

HTH!

Upvotes: 2

Related Questions