Question

我有启用了单元格选择的第一个DT表oTable。用户单击（选择）一个单元格时，将生成另一个DT表nTable。

然后，我要在nTable中插入一个selectInput。下面的代码是一个有效的示例。大部分改编自this post。

问题：
重新生成nTable时，与shinyValue的连接（绑定？）以某种方式断开。

重现问题的步骤：

启动应用。
选择左上方的单元格（例如Sepal.Length = 5.1）。实际上，选择任何单元格也将起作用。
在下面生成的第二个DT中，将selectInput中的col从A更改为B。检查下面的TableOutput中是否检测到此更改。
取消选择所选单元格
重新选择同一单元格。
现在，您可以再次更改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())))
    })
  }

))

将选择输入嵌入到具有单元格选择的其他DT生成的DT中

1 个答案: