从一个模块调用到另一个模块时，R Shiny 中带有 DT 和 data.table 的闪亮绑定输入类丢失了

Question

我正在尝试构建一个闪亮的应用程序，在 DT 包的帮助下使用 data.table 中动态创建的输入。在下面的示例中，在 module2 服务器中，我从 module1 获取名为“module1_data”的反应式数据表，并尝试创建带有下拉列表的列（使用“module1_data”），以便为每行分配值并将其保存在数据库表中。

但是下拉用户输入仅在第一个实例中被捕获，而在第二个实例中，则不会捕获用户输入。

我在网上找到的解决方案之一是我应该在渲染数据之前取消绑定，但没有成功。如果有人可以提供帮助，那将会很有帮助。提前致谢。 shiny-bound-input 类在带有 DT 和 data.table 的 R Shiny 中丢失了

以下是示例。

module1UI <- function(id) {
  #UI section
}

module1 <- function(input, output, session) {
  ns <- NS("module1")
#......
  return(
    list(
      module1_data = reactive({rv$data})
    )
  )
}
 
##########################

module2UI <- function (id){
  
  tagList(
    tags$head(tags$script(
      HTML(
        "Shiny.addCustomMessageHandler('unbindDT', 
                                    table.rows().every(function(i, tab, row) {
                                    var $this = $(this.node());
                                    $this.attr('id', this.data()[0]);
                                    $this.addClass('shiny-input-container');
                                    Shiny.unbindAll(this.api().table().node());
                                  });
                                  
                              )"
      )
    )),
    DT::dataTableOutput(ns('op_data')),
    actionButton(ns('save_inputs'), 'Save Inputs')
    
  )
  
}

module2 <- function(input, output, session, module1_server) {
  
  ns <- NS("module2")
  
  data <- reactive({
    
    data2 <- module1_server$module1_data()
    data2$select_val <- ''
    
    for (i in 1:nrow(data2)) {
      data2$select_val[i] <- as.character(selectInput(ns(paste0("sel", i)),
                                                                   "",
                                                                   choices = c("A","B","C","D"),
                                                                   width = "100px"))
    }
    
    data2
  })
  
  output$op_data = DT::renderDT(
    {
      datatable(
        data(),
        escape = FALSE, selection = 'none', 
        options = list(scrollY = 1000, dom = 't', paging = FALSE, ordering = FALSE,
                       preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                       drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }'))
        , rownames = FALSE
      )
    }, server = FALSE)
  
  
  observeEvent(input$save_inputs, {
    
    session$sendCustomMessage("unbindDT", "op_data")
    
    inputs <- sapply(1:nrow(data()), function(i) input[[paste0("sel", i)]])
    
    # Inputs data.frame
    data3 <- cbind(data(),inputs)
    
    #Inserting data into database
    sql_res <- tryCatch({
      dbExecute(conn,"drop table if exists tbl1")
      dbWriteTable(conn,"tbl1",data3)
      TRUE
    }, error = function(e) {
      debugmsg(3,"Error running statement: {e}")
      print(e)
      return(FALSE)
    })
    
    if (sql_res){
      shinyalert("Submitted","Submitted sucessfully", type = "success")
      
    }
  })
  
}

ui <- fluidPage(
  #....
)

server <- function(input, output, session) {
  
  module1_server <- callModule(module1, "module1")
  
  module2_server <- callModule(module2, "module2", module1_server)
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

您的自定义消息处理程序不正确。应该是

  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());
        }
      })")
  )),