javascript - 数据表的复杂 R Shiny 输入绑定(bind)问题

Question

我正在尝试做一些有点棘手的事情，我希望有人能帮助我。

我想在数据表中添加 selectInput。 如果我启动该应用程序，我会看到输入 col_1、col_2.. 与数据表连接良好(您可以切换到 a、b 或 c)

但是 如果我更新数据集(从 iris 到 mtcars)，输入和数据表之间的连接就会丢失。现在，如果您更改 selectinput，日志不会显示修改。如何保留链接？

我使用 shiny.bindAll() 和 shiny.unbindAll() 做了一些测试但没有成功。

有什么想法吗？

请查看应用程序:

library(shiny)
library(DT)
library(shinyjs)
library(purrr)

    ui <- fluidPage(
      selectInput("data","choose data",choices = c("iris","mtcars")),
      DT::DTOutput("tableau"),
      verbatimTextOutput("log")
    )

    server <- function(input, output, session) {
      dataset <- reactive({
        switch (input$data,
          "iris" = iris,
          "mtcars" = mtcars
        )
      })

      output$tableau <- DT::renderDT({
        col_names<-
          seq_along(dataset()) %>% 
        map(~selectInput(
          inputId = paste0("col_",.x),
          label = NULL, 
          choices = c("a","b","c"))) %>% 
          map(as.character)

        DT::datatable(dataset(),
                  options = list(ordering = FALSE, 
                          preDrawCallback = JS("function() {
                                               Shiny.unbindAll(this.api().table().node()); }"),
                         drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());
                         }")
          ),
          colnames = col_names, 
          escape = FALSE         
        )

      })
      output$log <- renderPrint({
        lst <- reactiveValuesToList(input)
        lst[order(names(lst))]
      })

    }

    shinyApp(ui, server)

Answer 1

了解您的挑战:

为了确定手头的挑战，您必须了解两件事。

1. 如果刷新数据表，它将被“删除”并从中构建 从头开始(这里不是 100% 确定，我想我在某个地方读过)。
2. 请记住，您实际上是在构建 html 页面。

selectInput()只是 html 代码的包装器。如果您键入 selectInput("a", "b", "c")在控制台中它将返回:

<div class="form-group shiny-input-container">
  <label class="control-label" for="a">b</label>
  <div>
    <select id="a"><option value="c" selected>c</option></select>
    <script type="application/json" data-for="a" data-nonempty="">{}</script>
  </div>
</div>

请注意，您正在构建 <select id="a"> , 选择 id="a" .因此，如果我们假设 1) 在刷新后是正确的，您将尝试构建另一个 html 元素:<select id="a">有一个现有的ID。这不应该起作用:Can multiple different HTML elements have the same ID if they're different elements? . (假设我的假设 1)成立；))

解决您的挑战:

乍一看非常简单:只需确保您使用的 id 在创建的 html 文档中是唯一的。

非常快速和肮脏的方法是替换:

inputId = paste0("col_",.x)

类似:inputId = paste0("col_", 1:nc, "-", sample(1:9999, nc)) .

但这对你来说以后很难使用。

更长的路:

所以你可以使用某种内存

1. 您已经使用过哪些 ID。
2. 哪些是您当前使用的 ID。

你可以使用

  global <- reactiveValues(oldId = c(), currentId = c())

为此。

过滤掉旧使用的 ID 并提取当前 ID 的想法可能是这样的:

    lst <- reactiveValuesToList(input)
    lst <- lst[setdiff(names(lst), global$oldId)]
    inp <- grepl("col_", names(lst))
    names(lst)[inp] <- sapply(sapply(names(lst)[inp], strsplit, "-"), "[", 1)

可重现的例子应该是:

library(shiny)
library(DT)
library(shinyjs)
library(purrr)

ui <- fluidPage(
  selectInput("data","choose data",choices = c("iris","mtcars")),
  dataTableOutput("tableau"),
  verbatimTextOutput("log")
)

server <- function(input, output, session) {

  global <- reactiveValues(oldId = c(), currentId = c())

  dataset <- reactive({
    switch (input$data,
            "iris" = iris,
            "mtcars" = mtcars
    )
  })

  output$tableau <- renderDataTable({
    isolate({
      global$oldId <- c(global$oldId, global$currentId)
      nc <- ncol(dataset())
      global$currentId <- paste0("col_", 1:nc, "-", sample(setdiff(1:9999, global$oldId), nc))

      col_names <-
        seq_along(dataset()) %>% 
        map(~selectInput(
          inputId = global$currentId[.x],
          label = NULL, 
          choices = c("a","b","c"))) %>% 
        map(as.character)
    })    
    DT::datatable(dataset(),
                  options = list(ordering = FALSE, 
                                 preDrawCallback = JS("function() {
                                                      Shiny.unbindAll(this.api().table().node()); }"),
                                 drawCallback = JS("function() { Shiny.bindAll(this.api().table().node());
}")
          ),
          colnames = col_names, 
          escape = FALSE         
    )

})
  output$log <- renderPrint({
    lst <- reactiveValuesToList(input)
    lst <- lst[setdiff(names(lst), global$oldId)]
    inp <- grepl("col_", names(lst))
    names(lst)[inp] <- sapply(sapply(names(lst)[inp], strsplit, "-"), "[", 1)
    lst[order(names(lst))]
  })

}

shinyApp(ui, server)