embed select input in DT generated from another DT with cell selection

Question

I have a first DT table oTable with cell selection enabled. When the user click (select) a cell, that will generate another DT table nTable.

Then, in nTable I want to insert a selectInput. The code below is a working example. Mostly adapted from this post.

Problem:
When nTable is regenerated, the connection (binding?) with shinyValue is somehow broken.

Step to reproduce the problem:

1. launch the app.
2. select top left cell (e.g. Sepal.Length=5.1). In fact, select any cell will also work.
3. In the second DT generated below, change the selectInput in col from A to something else, say, B. Check that this change is detected in the TableOutput below.
4. De-select the selected cell
5. Re-select the same cell.
6. Now, you can change the selectInput again but no changes will be detected.

Also, I am not sure how to use session$sendCustomMessage("unbind-DT", "oTable"), I tried changing oTable to nTable but that didn't work.

    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'),
    DT::dataTableOutput("oTable"),
    DT::dataTableOutput("nTable"),
    h2("Selected"),
    tableOutput("checked")
          ),

    server = function(input, output, session) {

      # 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, ...))
        }
        inputs
      }

      mydata=reactive({
        session$sendCustomMessage("unbind-DT", "oTable")

        input$oTable_cells_selected
      })

      output$nTable=renderDataTable({
        req(mydata())
        dd=as.data.frame(mydata())
        dd$col=shinyInput(selectInput,nrow(dd),"selecter_",choices=LETTERS[1:3])
        dd
        },selection='none',server=FALSE,escape=FALSE,rownames=FALSE,
        options=list(
            preDrawCallback = JS(
              'function() {
              Shiny.unbindAll(this.api().table().node()); }'
            ),
            drawCallback = JS('function() {
                              Shiny.bindAll(this.api().table().node()); } ')
        ))

      output$oTable=renderDataTable(DT::datatable(iris,selection=list(mode="multiple",target='cell')))


      # helper function for reading select input
      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 selectInput
      output$checked <- renderTable({
        req(mydata())
        data.frame(selected = shinyValue("selecter_", nrow(mydata())))
      })
    }

      ))

Dogeared

Answer 1

You have to run Shiny.unbindAll on nTable (the table which contains the inputs). But only after the table has been created a first time.

library(shiny)
library(DT)
runApp(list(
  ui = basicPage(
    tags$head(tags$script(
      HTML(
        "Shiny.addCustomMessageHandler('unbindDT', function(id) {
           var $table = $('#'+id).find('table');
           if($table.length > 0){
             Shiny.unbindAll($table.DataTable().table().node());
           }
        })"
    ))
    ),
    h2('The data'),
    DT::dataTableOutput("oTable"),
    DT::dataTableOutput("nTable"),
    h2("Selected"),
    tableOutput("checked")
      ),

  server = function(input, output, session) {

    # 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, ...))
      }
      inputs
    }

    observeEvent(input$oTable_cells_selected, {
      session$sendCustomMessage("unbindDT", "nTable")
    })

    mydata = eventReactive(input$oTable_cells_selected, {
      if(length(input$oTable_cells_selected)){
        input$oTable_cells_selected
      }
    })

    output$nTable=DT::renderDataTable({
      req(mydata())
      dd=as.data.frame(mydata())
      dd$col=shinyInput(selectInput,nrow(dd),"selecter_",choices=LETTERS[1:3])
      datatable(dd, selection='none', escape=FALSE,rownames=FALSE,
                options=list(
                  preDrawCallback = JS(
                    'function() {
                    Shiny.unbindAll(this.api().table().node()); }'
                  ),
                  drawCallback = JS('function() {
                                    Shiny.bindAll(this.api().table().node()); } ')
                  )) 
    },server=FALSE)

    output$oTable=DT::renderDataTable(
      DT::datatable(iris,selection=list(mode="multiple",target='cell'), 
                    options=list(pageLength = 5)))


    # helper function for reading select input
    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 selectInput
    output$checked <- renderTable({
      req(mydata())
      data.frame(selected = shinyValue("selecter_", nrow(mydata())))
    })
  }

))

Wolverine