R DT:：datatable中的文本输入解除绑定，我可以'；别再绑了

我正在开发一个闪亮的应用程序，允许用户输入关于观察的评论。注释随后保存在后端的SQL数据库中。下面的代码是我当前应用程序的工作表示

library(shiny)
library(DT)
library(dplyr)

mtcars$comment <- rep("", nrow(mtcars))
mtcars$row_id <- seq_len(nrow(mtcars))
AppData <- split(mtcars, mtcars[c("cyl", "am")])

# Makes a text input column out of a data frame
make_inputtable <- function(df){
  df$comment <- 
    mapply(
      function(comment, id){
        as.character(textInput(inputId = sprintf("txt_comment_%s", id), 
                               label = "", 
                               value = comment))
      }, 
      comment = df$comment, 
      id = df$row_id, 
      SIMPLIFY = TRUE)

  df
}

ui <- shinyUI(
  fluidPage(
    radioButtons(inputId = "rdo_cyl", 
                 label = "Cylinders", 
                 choices = sort(unique(mtcars$cyl)), 
                 inline = TRUE), 

    h3("Automatic"), 
    actionButton(inputId = "btn_save_automatic", 
                 label = "Save Comments"),
    DT::dataTableOutput("am0"),

    hr(),

    h3("Manual"), 
    actionButton(inputId = "btn_save_manual", 
                 label = "Save Comments"),
    DT::dataTableOutput("am1"), 

    # unbind a datatable. Needs to be done before a table is redrawn.
    tags$script(HTML(
      "Shiny.addCustomMessageHandler('unbind-DT', function(id) {
          Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
          })"))
  )
)


server <- shinyServer(function(input, output, session){
  reactiveData <- reactiveValues(
    am0_cyl4 = AppData[["4.0"]],
    am0_cyl6 = AppData[["6.0"]], 
    am0_cyl8 = AppData[["8.0"]],
    am1_cyl4 = AppData[["4.1"]],
    am1_cyl6 = AppData[["6.1"]], 
    am1_cyl8 = AppData[["8.1"]]
  ) 

  # Reactive Objects ------------------------------------------------

  ref0 <- reactive({
    sprintf("am0_cyl%s", input$rdo_cyl)
  })

  data0 <- reactive({
    reactiveData[[ref0()]]
  })

  ref1 <- reactive({
    sprintf("am1_cyl%s", input$rdo_cyl)
  })

  data1 <- reactive({
    reactiveData[[ref1()]]
  })

  # Event Observers -------------------------------------------------

  observeEvent(
    input$btn_save_automatic, 
    {
      in_field <- names(input)[grepl("^txt_comment_", names(input))]
      in_field_id <- sub("^txt_comment_", "", in_field)
      in_field_id <- as.numeric(in_field_id)
      in_field_id <- in_field_id[in_field_id %in% data0()$row_id]

      exist_frame <- data0()[c("row_id", "comment")]
      new_frame <- 
        data.frame(
          row_id = in_field_id, 
          comment = vapply(in_field_id, 
                           function(id){ input[[sprintf("txt_comment_%s", id)]]}, 
                           character(1)), 
          stringsAsFactors = FALSE)

      Compare <- left_join(exist_frame, 
                           new_frame, 
                           by = "row_id", 
                           suffix = c("_exist", "_new")) %>% 
        filter(comment_exist != comment_new)

      message(sprintf("* %s comment(s) saved", nrow(Compare)))

      # Only perform the save operations if there are changes to be made.
      if (nrow(Compare)){
        session$sendCustomMessage("unbind-DT", "am0")

        for(i in seq_len(nrow(Compare))){
          row <- Compare$row_id
          reactiveData[[ref0()]]$comment[reactiveData[[ref0()]]$row_id == row] <- 
            input[[sprintf("txt_comment_%s", row)]]
        }
        print(data0())
      }

    }
  )

  # Very similar to btn_save_automatic
  observeEvent(
    input$btn_save_manual, 
    {
      in_field <- names(input)[grepl("^txt_comment_", names(input))]
      in_field_id <- sub("^txt_comment_", "", in_field)
      in_field_id <- as.numeric(in_field_id)
      in_field_id <- in_field_id[in_field_id %in% data1()$row_id]

      exist_frame <- data1()[c("row_id", "comment")]
      new_frame <- 
        data.frame(
          row_id = in_field_id, 
          comment = vapply(in_field_id, 
                           function(id){ input[[sprintf("txt_comment_%s", id)]]}, 
                           character(1)), 
          stringsAsFactors = FALSE)

      Compare <- left_join(exist_frame, 
                           new_frame, 
                           by = "row_id", 
                           suffix = c("_exist", "_new")) %>% 
        filter(comment_exist != comment_new)

      message(sprintf("* %s comment(s) saved", nrow(Compare)))

      # Only perform the save operations if there are changes to be made.
      if (nrow(Compare)){
        session$sendCustomMessage("unbind-DT", "am1")

        for(i in seq_len(nrow(Compare))){
          row <- Compare$row_id
          reactiveData[[ref1()]]$comment[reactiveData[[ref1()]]$row_id == row] <- 
            input[[sprintf("txt_comment_%s", row)]]
        }
        print(data1())
      }

    }
  )


  # Output Objects --------------------------------------------------

  output$am0 <-
    DT::renderDataTable({
      make_inputtable(data0()) %>%
        datatable(escape = -13, 
                  options = list(preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
    })

  output$am1 <-
    DT::renderDataTable({
      make_inputtable(data1()) %>%
        datatable(escape = -13, 
                  options = list(preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
    })


})

shinyApp(ui = ui, server = server)

正在发生的事情是，使用Cylinder=4的子集（单选按钮）加载表格，用户可以保存注释，进入Cylinder=6，保存注释，然后是Cylinder=8，然后保存注释。但是，如果我将圆柱体更改回已保存注释的值，则文本输入将解除绑定，并且不会保存任何注释。为了恢复功能，我必须重新启动应用程序。我发现这会激怒我的用户

如果返回到已使用的圆柱体值，我需要做什么来确保可以继续保存注释

很抱歉，这不是一个非常简洁的例子。当您输入注释时，控制台将打印保存的注释数，并显示更改的数据框，以便您可以比较应用程序中显示的内容

library(shiny)
library(DT)
library(dplyr)

mtcars$comment <- rep("", nrow(mtcars))
mtcars$row_id <- seq_len(nrow(mtcars))
AppData <- split(mtcars, mtcars[c("cyl", "am")])

# Makes a text input column out of a data frame
make_inputtable <- function(df){
  df$comment <- 
    mapply(
      function(comment, id){
        as.character(textInput(inputId = sprintf("txt_comment_%s", id), 
                               label = "", 
                               value = comment))
      }, 
      comment = df$comment, 
      id = df$row_id, 
      SIMPLIFY = TRUE)

  df
}

ui <- shinyUI(
  fluidPage(
    radioButtons(inputId = "rdo_cyl", 
                 label = "Cylinders", 
                 choices = sort(unique(mtcars$cyl)), 
                 inline = TRUE), 

    h3("Automatic"), 
    actionButton(inputId = "btn_save_automatic", 
                 label = "Save Comments"),
    DT::dataTableOutput("am0"),

    hr(),

    h3("Manual"), 
    actionButton(inputId = "btn_save_manual", 
                 label = "Save Comments"),
    DT::dataTableOutput("am1"), 

    # unbind a datatable. Needs to be done before a table is redrawn.
    tags$script(HTML(
      "Shiny.addCustomMessageHandler('unbind-DT', function(id) {
          Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
          })"))
  )
)


server <- shinyServer(function(input, output, session){
  reactiveData <- reactiveValues(
    am0_cyl4 = AppData[["4.0"]],
    am0_cyl6 = AppData[["6.0"]], 
    am0_cyl8 = AppData[["8.0"]],
    am1_cyl4 = AppData[["4.1"]],
    am1_cyl6 = AppData[["6.1"]], 
    am1_cyl8 = AppData[["8.1"]]
  ) 

  # Reactive Objects ------------------------------------------------

  ref0 <- reactive({
    sprintf("am0_cyl%s", input$rdo_cyl)
  })

  data0 <- reactive({
    reactiveData[[ref0()]]
  })

  ref1 <- reactive({
    sprintf("am1_cyl%s", input$rdo_cyl)
  })

  data1 <- reactive({
    reactiveData[[ref1()]]
  })

  # Event Observers -------------------------------------------------

  observeEvent(
    input$btn_save_automatic, 
    {
      in_field <- names(input)[grepl("^txt_comment_", names(input))]
      in_field_id <- sub("^txt_comment_", "", in_field)
      in_field_id <- as.numeric(in_field_id)
      in_field_id <- in_field_id[in_field_id %in% data0()$row_id]

      exist_frame <- data0()[c("row_id", "comment")]
      new_frame <- 
        data.frame(
          row_id = in_field_id, 
          comment = vapply(in_field_id, 
                           function(id){ input[[sprintf("txt_comment_%s", id)]]}, 
                           character(1)), 
          stringsAsFactors = FALSE)

      Compare <- left_join(exist_frame, 
                           new_frame, 
                           by = "row_id", 
                           suffix = c("_exist", "_new")) %>% 
        filter(comment_exist != comment_new)

      message(sprintf("* %s comment(s) saved", nrow(Compare)))

      # Only perform the save operations if there are changes to be made.
      if (nrow(Compare)){
        session$sendCustomMessage("unbind-DT", "am0")

        for(i in seq_len(nrow(Compare))){
          row <- Compare$row_id
          reactiveData[[ref0()]]$comment[reactiveData[[ref0()]]$row_id == row] <- 
            input[[sprintf("txt_comment_%s", row)]]
        }
        print(data0())
      }

    }
  )

  # Very similar to btn_save_automatic
  observeEvent(
    input$btn_save_manual, 
    {
      in_field <- names(input)[grepl("^txt_comment_", names(input))]
      in_field_id <- sub("^txt_comment_", "", in_field)
      in_field_id <- as.numeric(in_field_id)
      in_field_id <- in_field_id[in_field_id %in% data1()$row_id]

      exist_frame <- data1()[c("row_id", "comment")]
      new_frame <- 
        data.frame(
          row_id = in_field_id, 
          comment = vapply(in_field_id, 
                           function(id){ input[[sprintf("txt_comment_%s", id)]]}, 
                           character(1)), 
          stringsAsFactors = FALSE)

      Compare <- left_join(exist_frame, 
                           new_frame, 
                           by = "row_id", 
                           suffix = c("_exist", "_new")) %>% 
        filter(comment_exist != comment_new)

      message(sprintf("* %s comment(s) saved", nrow(Compare)))

      # Only perform the save operations if there are changes to be made.
      if (nrow(Compare)){
        session$sendCustomMessage("unbind-DT", "am1")

        for(i in seq_len(nrow(Compare))){
          row <- Compare$row_id
          reactiveData[[ref1()]]$comment[reactiveData[[ref1()]]$row_id == row] <- 
            input[[sprintf("txt_comment_%s", row)]]
        }
        print(data1())
      }

    }
  )


  # Output Objects --------------------------------------------------

  output$am0 <-
    DT::renderDataTable({
      make_inputtable(data0()) %>%
        datatable(escape = -13, 
                  options = list(preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
    })

  output$am1 <-
    DT::renderDataTable({
      make_inputtable(data1()) %>%
        datatable(escape = -13, 
                  options = list(preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
    })


})

shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（DT）
图书馆（dplyr）
mtcars$comment您解除绑定的时间太早或太晚，我无法从您发布的代码片段中确定。是否可以将同一类型的多个对象绑定到

编辑：

我觉得这句话很可疑：

# unbind a datatable. Needs to be done before a table is redrawn.
 tags$script(HTML(
   "Shiny.addCustomMessageHandler('unbind-DT', function(id) {


    Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
           })"))   )

似乎您要解除绑定两次，只绑定一次。
抛开版本限制，下面是我如何使用最新的
库（DT）
版本来实现这一点（希望对未来的读者有用，也许有一天您也会更新）：

编辑：现在使用
dataTableProxy
避免重新渲染

library(shiny)
library(DT)

ui <- shinyUI(
  fluidPage(
    radioButtons(inputId = "rdo_cyl", 
                 label = "Cylinders", 
                 choices = sort(unique(mtcars$cyl)), 
                 inline = TRUE), 
    h3("Automatic"), 
    actionButton(inputId = "btn_save_automatic", 
                 label = "Save Comments"), p(),
    DTOutput("am0"),
    hr(),
    h3("Manual"), 
    actionButton(inputId = "btn_save_manual", 
                 label = "Save Comments"), p(),
    DTOutput("am1")
  )
)

server <- shinyServer(function(input, output, session){
  globalData <- mtcars
  globalData$comment <- rep("", nrow(mtcars))
  globalData$row_id <- seq_len(nrow(mtcars))

  diabledCols <- grep("comment", names(globalData), invert = TRUE)
  AppData <- reactiveVal(globalData)

  automaticAppData <- reactive({
    AppData()[AppData()[["cyl"]] %in% input$rdo_cyl & AppData()[["am"]] %in% "0", ]
  })

  manualAppData <- reactive({
    AppData()[AppData()[["cyl"]] %in% input$rdo_cyl & AppData()[["am"]] %in% "1", ]
  })

  output$am0 <- DT::renderDT(
    # isolate: render only once
    expr = {isolate(automaticAppData())},
    editable = list(target = "cell", disable = list(columns = diabledCols))
  )

  output$am1 <- DT::renderDT(
    # isolate: render only once
    expr = {isolate(manualAppData())},
    editable = list(target = "cell", disable = list(columns = diabledCols))
  )

  observeEvent(input$btn_save_automatic, {
    info = input$am0_cell_edit
    str(info)
    i = automaticAppData()$row_id[[info$row]]
    j = info$col
    v = info$value
    globalData[i, j] <<- DT::coerceValue(v, globalData[i, j])
    AppData(globalData)
    # update database...
  })

  observeEvent(input$btn_save_manual, {
    info = input$am1_cell_edit
    str(info)
    i = manualAppData()$row_id[[info$row]]
    j = info$col
    v = info$value
    globalData[i, j] <<- DT::coerceValue(v, globalData[i, j])
    AppData(globalData)
    # update database...
  })

  am0Proxy <- dataTableProxy("am0")
  am1Proxy <- dataTableProxy("am1")

  observeEvent(automaticAppData(), {
    replaceData(am0Proxy, automaticAppData(), resetPaging = FALSE)
  })

  observeEvent(manualAppData(), {
    replaceData(am1Proxy, manualAppData(), resetPaging = FALSE)
  })

})

shinyApp(ui = ui, server = server)

您使用
textInput
s有什么具体原因吗？我会创建一个评论栏，并使其可编辑，参见第2.3章。这是一个选项吗？
editable
参数不在我使用的
DT
版本中。升级是一种选择，但会很费时，成本也会有点高。如果在当前代码库中无法解决此问题，则需要升级。我将用我们正在运行的版本更新这个问题。为了确保我理解，您是否建议创建六个不同的输出对象（而不是示例中的两个）来绑定？这是可能的。同样，重构时间将是一个巨大的复杂因素。实际上，这将导致54个不同的对象进行绑定。（当我启动应用程序时，这些评论不在路线图中，所以我会进行重大的重构）是的，那太糟糕了。我可以在这里了解更多有关流程的信息吗？基本上，就我所见，你是两次解绑，一次捆绑。我将编辑答案。希望有更有经验的人来看看这个问题：）我以为发生的是1。加载数据库中的数据，并呈现表。2.用户在输入框中输入评论，然后按“保存评论”3。注释将保存到数据库中。4.数据表和输入框未绑定。5.
reactiveData
中的数据帧将被更新。这将触发要重绘的datatable对象。在重画时，我预计输入字段会被
options
to
datatable
中的
drawCallback
参数反弹。但是我明白你所说的在
preDrawCallback
和
unbind DT
之间解绑两次是什么意思了。重载/重画和重新绑定是不同的命令。可能您需要删除一个解除绑定以防止它两次解除绑定，并在重新绑定后调用dt对象的重载函数。非常感谢。这是非常有帮助的。