閃亮：在非活動tabPanel上更新DT

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的選項卡未處於活動狀態時，即使設置了suspendWhenHidden = FALSE並且似乎調用了renderDT ， DT也不會更新。

我發現一個公開的問題抱怨類似的問題，但沒有提供解決方案。

我也發現了這個問題，並試圖讓它適應我的問題。 到目前為止，我通過運行$("#dt_test table").DataTable().draw();來更新DT成功$("#dt_test table").DataTable().draw(); 從瀏覽器控制台。 DT在點擊時也會更新（例如，在排序按鈕上）。

我正在尋找一種方法來在輸入更改（或其初始化）時立即更新DT ，無論它是否在活動面板上。 特別麻煩的一個特殊情況是應用程序啟動時 - DT不會立即呈現。 看來圖紙只在它所在的標簽打開時開始（它顯示處理... ）。 在我的實際應用程序中，這會引入幾秒滯后 - 這就是為什么我想在用戶查看其他選項卡時強制處理DT的原因。

我試驗了包含運行$("#dt_test table").DataTable().draw();的javascript文件$("#dt_test table").DataTable().draw(); 在各種活動，但到目前為止沒有成功。

有沒有辦法通過上述事件或任何其他方法實現我正在尋找的東西？

Answer 1

我想出了兩個可能的解決方案。

1. 通過使用觀察者，但使用此解決方案時，表將在切換到數據表選項卡時更新，而不是之前。

這是受兩個視頻的啟發，這些視頻真的有助於更好地理解閃亮的效果如何：

閃亮的開發者大會2016 - 冷杉兩個列出的視頻

2. 通過使用代理對象，此選項需要通過在呈現表時設置適當的選項來進行服務器端處理（請參閱下面的此解決方案的代碼）

解決方案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

根據這個帖子 ，如果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在tabPanel或conditionalPanel中時，DT可能不會更新。