встроить вход выбора в DT, сгенерированный из другого DT с выбором ячейки

Question

У меня есть первая таблица DT oTable с включенным выбором ячеек. Когда пользователь щелкает (выбирает) ячейку, это создает другую таблицу DT nTable.

Затем в nTable я хочу вставить selectInput. Код ниже является рабочим примером. В основном адаптировано из этого поста .

Проблема:
Когда nTable восстанавливается, соединение (связывание?) С shinyValue как-то разрывается.

Шаг для воспроизведения проблемы:

1. запустите приложение.
2. выберите верхнюю левую ячейку (например, Sepal.Length = 5.1). На самом деле, выбрать любую ячейку тоже будет работать.
3. Во втором DT, сгенерированном ниже, измените selectInput в col с A на что-то другое, скажем, B. Убедитесь, что это изменение обнаружено в TableOutput ниже.
4. Отменить выбор выбранной ячейки
5. Повторно выберите ту же ячейку.
6. Теперь вы можете снова изменить selectInput, но изменения не будут обнаружены.

Кроме того, я не уверен, как использовать session$sendCustomMessage("unbind-DT", "oTable"), я пытался изменить oTable на nTable, но это не сработало.

    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())))
      })
    }

      ))

Answer 1

Вы должны запустить Shiny.unbindAll на nTable (таблица, содержащая входные данные). Но только после первого создания таблицы.

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())))
    })
  }

))