復雜的R Shiny輸入綁定問題與數據表

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。 這不應該工作： 如果多個不同的HTML元素是不同的元素，它們可以具有相同的ID嗎？ 。 （假設我的假設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)