Question

TL; DR：当图形数据表位于非活动选项卡上但输入发生更改时，如何强制其绘制？

一个有光泽的应用程序，看起来像这样：

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抱怨类似的问题，但没有提供解决方案。

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

我正在寻找一种方法来根据输入更改（或其初始化）立即更新DT ，无论它是否在活动面板上。该问题的一个特殊情况是特别麻烦的是启动应用程序时-DT不会立即呈现。似乎只有在打开图形所在的选项卡时图形才会开始（它显示正在处理... ）。在我的实际应用中，这会引入几秒钟的延迟-这就是为什么我要在用户查看其他标签时强制处理DT。

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

是否可以通过上述事件或任何其他方法来实现我正在寻找的东西？

Answer 1

我提出了两种可能的解决方案。

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

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

Shiny developer conference 2016-列出两个视频

通过使用代理对象，此选项需要在呈现表时通过设置适当的选项来进行服务器端处理（请参见下面有关此解决方案的代码）

解决方案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，则当他们或他们的父母之一被display: none隐藏时会发生这种情况。 tabPanel和conditionalPanel就是这样隐藏它们的内容。

一种解决方法是绕过tabPanel并使用visibility属性有条件地自己渲染DT。当元素具有visibility: hidden时，它不会显示，但是会占用空间。

这是一个例子：

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。而且我也要小心使用它，因为我认为该错误仍然存在，当suspendWhenHidden = FALSE时DT可能不会更新，并且DT位于tabPanel或conditionalPanel中。

闪亮：在无效的tab面板上更新DT

2 个答案: