闪亮：在非活动 tabPanel 上更新 DT

Question

TL;DR：如何在非活动选项卡上强制绘制数据表但其输入发生变化？

A 有一个看起来像这样的闪亮应用程序：

library(shiny)
library(DT)
shinyApp(

  ui = fluidPage(

    sidebarLayout(

      sidebarPanel(
        numericInput(
          inputId = "random_val",
          label = "pick random value",
          value = 1
        )
      ),

      mainPanel(
        tabsetPanel(
          id = "tabset",
          tabPanel(
            title = "some_other_tab",
            "Some other stuff"
          ),
          tabPanel(
            title = "test_render",
            textOutput("echo_test"),
            DTOutput("dt_test")
          )
        )
      )
    )
  ),

  server = function(input, output) {

    output$echo_test <- renderText({
      cat("renderText called \n")
      input$random_val
    })
    outputOptions(output, "echo_test", suspendWhenHidden = FALSE)

    output$dt_test <- renderDT({
      cat("renderDT called \n")
      df <- data.frame(
        a = 1:10^6,
        b = rep(input$random_val, 10^6)
      )
      datatable(df)
    })
    outputOptions(output, "dt_test", suspendWhenHidden = FALSE)
  }

)

我的问题如下：当输入 ( input$random_value ) 在 test_render 选项卡（即带有 DT 的选项卡）打开时发生变化时，一切正常。但是，当包含 DT 的选项卡在用户更改其输入时未处于活动状态时，DT 不会更新，即使设置了 suspendWhenHidden = FALSE 并且似乎调用了 renderDT .

我发现 open issue 抱怨类似的问题，但没有提供解决方案。

我也找到了这个并尝试使它适应我的问题。到目前为止，我已成功通过浏览器控制台将 DT 更新为运行 $("#dt_test table").DataTable().draw();。 DT 在单击时也会更新（例如，在排序按钮上）。

我正在寻找一种方法来DT立即更新输入更改（或其初始化），无论它是否在活动面板上。这个问题的一个特别麻烦的特例是当应用程序启动时——DT 没有立即呈现。似乎绘图仅在其所在的选项卡打开时才开始（它显示 Processing...）。在我的实际应用程序中，这引入了几秒钟的延迟——这就是为什么我想在用户查看 其他选项卡 .

时强制处理 DT

我尝试包含一个 javascript 文件，该文件在各种 events 上运行 $("#dt_test table").DataTable().draw(); 但到目前为止没有成功。

有没有办法通过上述事件或任何其他方法实现我正在寻找的东西？

Answer 1

我想出了两个可能的解决方案。

通过使用观察器，但使用此解决方案 table 将在切换到数据 table 选项卡时更新，而不是之前。

这受到了两个视频的启发，这两个视频对更好地理解 shiny 的工作原理非常有帮助：

Shiny developer conference 2016 - 列出的前两个视频

通过使用代理对象，此选项需要服务器端处理，方法是在呈现 table 时设置适当的选项（请参阅下面此解决方案的代码）

解决方案 1

    library(shiny)
    library(DT)
    shinyApp(

            ui = fluidPage(

                    sidebarLayout(

                            sidebarPanel(
                                    numericInput(
                                            inputId = "random_val",
                                            label = "pick random value",
                                            value = 1
                                    )
                            ),

                            mainPanel(
                                    tabsetPanel(
                                            id = "tabset",
                                            tabPanel(
                                                    title = "some_other_tab",
                                                    "Some other stuff"
                                            ),
                                            tabPanel(
                                                    title = "test_render",
                                                    textOutput("echo_test"),
                                                    DTOutput("dt_test")
                                            )
                                    )
                            )
                    )
            ),

            server = function(input, output) {

                    output$echo_test <- renderText({
                            cat("renderText called \n")
                            input$random_val
                    })
                    outputOptions(output, "echo_test", suspendWhenHidden = FALSE)

                    observeEvent(input$random_val, {
                            cat("renderDT called \n")
                            df <- data.frame(
                                    a = 1:10^6,
                                    b = rep(input$random_val, 10^6)
                            )   
                            output$dt_test <- renderDT(df)
                    })
            }
    )

解决方案 2

    library(shiny)
    library(DT)
    shinyApp(

            ui = fluidPage(

                    sidebarLayout(

                            sidebarPanel(
                                    numericInput(
                                            inputId = "random_val",
                                            label = "pick random value",
                                            value = 1
                                    )
                            ),

                            mainPanel(
                                    tabsetPanel(
                                            id = "tabset",
                                            selected = "test_render",
                                            tabPanel(
                                                    title = "some_other_tab",
                                                    "Some other stuff"
                                            ),
                                            tabPanel(
                                                    title = "test_render",
                                                    textOutput("echo_test"),
                                                    DTOutput("dt_test")
                                            )
                                    )
                            )
                    )
            ),

            server = function(input, output, session) {

                    output$echo_test <- renderText({
                            cat("renderText called \n")
                            input$random_val
                    })
                    outputOptions(output, "echo_test", suspendWhenHidden = FALSE)
                    output$dt_test <- renderDT({
                            cat("renderDT called \n")
                            df <- data.frame(
                                    a = 1:10^6,
                                    b = rep(1, 10^6)
                            )
                            datatable(df)
                    }, server = TRUE)
                    observeEvent(input$random_val, {
                            df <- data.frame(
                                    a = 1:10^6,
                                    b = rep(input$random_val, 10^6)
                            )
                            dt_test_proxy <- dataTableProxy("dt_test", session = shiny::getDefaultReactiveDomain(),
                                                            deferUntilFlush = TRUE)
                            replaceData(dt_test_proxy, df)
                            cat("table updated \n")
                    })
                    updateTabsetPanel(session, "tabset", selected = "some_other_tab")
            }
    )

如果有帮助请告诉我....

Answer 2

根据此 thread，DT 小部件如果隐藏在页面上则不会呈现： https://github.com/rstudio/DT/blob/ca5e7645b42c021137d4333c2f781b62abf32ad1/inst/htmlwidgets/datatables.js#L113

更具体地说，如果他们的 DOM 元素的 offsetWidth 和 offsetHeight 是 0，如果他们或他们的 parents 之一被隐藏 display: none。这就是 tabPanel 和 conditionalPanel 隐藏内容的方式。

一种解决方法可能是绕过 tabPanel 并使用 visibility 属性有条件地自己渲染 DT。当一个元素有visibility: hidden时，它不显示，但它确实占用了space。

这是一个例子：

library(shiny)
library(DT)

hiddenPanel <- function(...) {
  div(style = "visibility: hidden;", ...)
}

toggleVisibility <- function(id, visible, session = getDefaultReactiveDomain()) {
  session$sendCustomMessage("toggle-visibility", list(id = id, visible = visible))
}

shinyApp(
  ui = fluidPage(
    tags$head(
      tags$script("
        Shiny.addCustomMessageHandler('toggle-visibility', function(msg) {
          $('#' + msg.id).css('visibility', msg.visible ? 'visible' : 'hidden');
        });
      ")
    ),

    sidebarLayout(
      sidebarPanel(
        numericInput(
          inputId = "random_val",
          label = "pick random value",
          value = 1
        )
      ),

      mainPanel(
        tabsetPanel(
          id = "tabset",
          tabPanel(
            title = "some_other_tab",
            "Some other stuff"
          ),
          tabPanel(
            title = "test_render"
          )
        ),

        hiddenPanel(
          id = "dt_test_panel",
          DTOutput("dt_test")
        )
      )
    )
  ),

  server = function(input, output, session) {
    output$dt_test <- renderDT({
      cat("renderDT called \n")
      df <- data.frame(
        a = 1:10^4,
        b = rep(input$random_val, 10^4)
      )
      datatable(df)
    })

    observeEvent(input$tabset, {
      toggleVisibility("dt_test_panel", input$tabset == "test_render")
    })
  }
)

注意这里不需要设置suspendWhenHidden = FALSE。而且我也会谨慎使用它，因为我认为该错误仍然存在，其中 DT 在 suspendWhenHidden = FALSE 时可能不会更新，并且 DT 在 tabPanel 或 conditionalPanel 中。

闪亮：在非活动 tabPanel 上更新 DT

Shiny: update DT on inactive tabPanel

javascript

jquery

r

shiny

dt