DT：重新渲染表格后链接绑定丢失

Question

我试图通过单击数据表中嵌套的链接导航到下一个选项卡。

第一次使用时效果很好Shiny.bindAll。在这里您可以找到 Joe Cheng 关于该功能使用的解释。

但是，当通过过滤输入数据来重新渲染数据表时，selectInput从 2 切换回 1 时绑定会丢失：

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

ui <- fluidPage(tabsetPanel(
  id = "panels",
  tabPanel("A",
           selectInput("sel", "Select", choices = c(1,2)),
           DTOutput("tab")),
  tabPanel("B",
           h3("Some information"),
           tags$li("Item 1"),
           tags$li("Item 2"),
           actionLink("goToTabPanelA", "goToTabPanelA")
  )
))

server <- function(input, output, session) {
  DF <- data.frame(a = c(1,2),
                   b = c(HTML('<a id="goToTabPanelB1" class="action-button" href="#">goToTabPanelB1</a>'),
                         HTML('<a id="goToTabPanelB2" class="action-button" href="#">goToTabPanelB2</a>')))
  
  output$tab <- renderDataTable({
    datatable(
      DF %>% filter(a %in% input$sel),
      escape = FALSE,
      selection = 'none',
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  })
  
  observeEvent(c(input$goToTabPanelB1, input$goToTabPanelB2), {
    updateTabsetPanel(session, "panels", "B")
  })
  
  observeEvent(input$goToTabPanelA, {
    updateTabsetPanel(session, "panels", "A")
  })
}

shinyApp(ui, server)

Answer 1

编辑：

另一种更简洁的方法（因为它一直对链接使用相同的 id）是通过使用dataTableProxywith来避免重新渲染数据表replaceData：

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

DF <- data.frame(id = paste0(c("goToTabPanelB1", "goToTabPanelB2")),
                 a = c(1,2),
                 b = c(HTML('<a id="goToTabPanelB1" class="action-button" href="#">goToTabPanelB1</a>'),
                       HTML('<a id="goToTabPanelB2" class="action-button" href="#">goToTabPanelB2</a>')))

ui <- fluidPage(tabsetPanel(
  id = "panels",
  tabPanel("A",
           selectInput("sel", "Select", choices = c(1,2)),
           DTOutput("tab")),
  tabPanel("B",
           h3("Some information"),
           tags$li("Item 1"),
           tags$li("Item 2"),
           actionLink("goToTabPanelA", "goToTabPanelA")
  )
))

server <- function(input, output, session) {
  
  output$tab <- renderDataTable({
    datatable(
      DF,
      escape = FALSE,
      selection = 'none',
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = TRUE)
  
  tabProxy <- dataTableProxy("tab", session)
  
  observeEvent(input$sel, {
    replaceData(tabProxy, data = DF[input$sel,])
  })
  
  observeEvent(c(input$goToTabPanelB1, input$goToTabPanelB2), {
    updateTabsetPanel(session, "panels", "B")
  })
  
  observeEvent(input$goToTabPanelA, {
    updateTabsetPanel(session, "panels", "A")
  })
}

shinyApp(ui, server)

初步回答：

一种可能的解决方法是在重新呈现数据表时提供带有新 ID 的链接（a 标签）（请参阅下面的代码）。

尽管如此，我还是想了解如果 id 是静态的并且数据表重新渲染会发生什么（因此我提供了赏金）。

该问题似乎与此处描述的问题类似。

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

ui <- fluidPage(tabsetPanel(
  id = "panels",
  tabPanel("A",
           selectInput("sel", "Select", choices = c(1,2)),
           DTOutput("tab")),
  tabPanel("B",
           h3("Some information"),
           tags$li("Item 1"),
           tags$li("Item 2"),
           actionLink("goToTabPanelA", "goToTabPanelA")
  )
))

server <- function(input, output, session) {
  DF <- reactive({
    # force id to update
    tmpId <- as.integer(Sys.time())
    tmpDF <- data.frame(id = paste0(c("goToTabPanelB1", "goToTabPanelB2"), tmpId),
               a = c(1,2),
               b = c(HTML(sprintf('<a id="goToTabPanelB1%s" class="action-button" href="#">goToTabPanelB1</a>', tmpId)),
                     HTML(sprintf('<a id="goToTabPanelB2%s" class="action-button" href="#">goToTabPanelB2</a>', tmpId))))
    
    tmpDF[input$sel,]
    })
  
  output$tab <- renderDataTable({
    datatable(
      DF(),
      escape = FALSE,
      selection = 'none',
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = FALSE)
  
  observeEvent(lapply(DF()$id, function(x){input[[x]]}), {
    updateTabsetPanel(session, "panels", "B")
  })
  
  observeEvent(input$goToTabPanelA, {
    updateTabsetPanel(session, "panels", "A")
  })
}

shinyApp(ui, server)

相关链接：

• 绑定/取消绑定 DataTable 时出现反应问题
• https://github.com/rstudio/shiny/issues/1246
• DT::datatable 中的文本输入解除绑定，我无法重新绑定它
• https://community.rstudio.com/t/what-is-the- Purpose-of-using-shiny-bindall/14489/2