TL;DR:当数据表在非事件选项卡上但其输入发生变化时，如何强制绘制数据表？

A 有一个 Shiny 的应用程序，看起来像这样:

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 是set 和 renderDT 似乎被调用了。

我找到了一个 open issue提示类似的问题，但没有提供解决方案。

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

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

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

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

最佳答案

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

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

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

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)
                    })
            }
    )

方案二

    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")
            }
    )

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

关于javascript - Shiny :在非事件 tabPanel 上更新 DT，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/51265725/