Question

我正在尝试使用Shiny输入元素（checkboxInput或textInput）创建一个数据表。在我更新数据表之前，此方法效果很好。如果我添加更多具有更多输入元素的行，则只有新元素起作用。我认为该表将在每次更新时重新创建，并且id将与新的输入元素相关联。下面的代码示例说明了该问题。它首先创建一张表。如果然后使用左侧的下拉列表创建具有两行的表，则只能读取输出表中第二行的值。第一行输入的任何更改都不会影响输出表。

library(DT)
library(shiny)
server <- function(input, output) {
  updateTable <- reactive({
    num <- as.integer(input$num)
    df <- data.frame(check = unlist(lapply(1:num, function(i) as.character(checkboxInput(paste0("check_", i), label = paste0("check", i), value = 0)))),
               text = unlist(lapply(1:num, function(i) as.character(textInput(paste0("text_",i), label = paste0("text", i), value = "")))))
  })

  output$input_ui <- DT::renderDataTable(
    updateTable(),
    server = FALSE, escape = FALSE, selection = 'none',
    options = list(
      dom = 't', paging = FALSE, ordering = FALSE,lengthChange = TRUE,
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
    )
  )

  output$table <- renderTable({
    num <- as.integer(input$num)
    data.frame(lapply(1:num, function(i) {
      paste(input[[paste0("check_", i)]], input[[paste0("text_",i)]], sep = " : ")
    }))
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("num", "select number of inputs", choices = seq(1,10,1))
    ),
    mainPanel(
      DT::dataTableOutput("input_ui"),
      tableOutput("table")
    )
  )
)

shinyApp(ui = ui, server = server)

Answer 1

此处提供了可能的解决方案：

https://groups.google.com/d/msg/shiny-discuss/ZUMBGGl1sss/7sdRQecLBAAJ

据我了解，由于使用了

，它允许在重画表之前“强制”完全取消所有复选框/文本输入的绑定

session$sendCustomMessage('unbind-DT', 'input_ui')

。我不假装真正理解它，但显然它是有效的。请参阅下面的可能的实现。

library(shiny)
library(DT)
server <- function(input, output,session) {
  updateTable <- reactive({
    num <- as.integer(input$num)
    session$sendCustomMessage('unbind-DT', 'input_ui')
    df <- data.frame(
      check = unlist(lapply(1:num, function(i) as.character(checkboxInput(paste0("check_", i), label = paste0("check", i), value = 0)))),
      text = unlist(lapply(1:num, function(i) as.character(textInput(paste0("text_",i), label = paste0("text", i), value = "")))))
    tbl <- DT::datatable(df, escape = FALSE,
                         selection = "none", 
                         options = list(
                           dom = 't', paging = FALSE, ordering = FALSE,lengthChange = TRUE,
                           preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                           drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                         ))

  })

  output$input_ui <- DT::renderDataTable(
    updateTable(),
    server = FALSE
  )

  output$table <- renderTable({
    num <- as.integer(input$num)
    data.frame(lapply(1:num, function(i) {
      paste(input[[paste0("check_", i)]], input[[paste0("text_",i)]], sep = " : ")
    }))
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("num", "select number of inputs", choices = seq(1,10,1))
    ),
    mainPanel(
      DT::dataTableOutput("input_ui"),
      tags$script(HTML(
        "Shiny.addCustomMessageHandler('unbind-DT', function(id) {
          Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
        })")),
      tableOutput("table")
    )
  )
)

shinyApp(ui = ui, server = server)

HTH！

更新数据表后，为什么数据表中的R / Shiny输入无法正常工作？

1 个答案: