Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Shiny: update DT on inactive tabPanel

TL;DR: How to force drawing datatable when it is on inactive tab but its input changes?

A have a shiny app which looks like that:

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

)

My problem is the following: When the input ( input$random_value ) changes while the tab test_render (i.e., the one with DT) is open, everything works properly. However, when the tab containing DT is not active while the user changes its input, DT does not get updated, even though suspendWhenHidden = FALSE is set and renderDT seems to be called.

I have found an open issue complaining about similar problem but no solution was offered.

I have also found this question and tried to adapt it to my problem. So far I am successful with updating DT by running $("#dt_test table").DataTable().draw(); from browser console. DT also gets updated when it is clicked (e.g., on the sort button).

I am looking for a way to update DT immediately on input changes (or its initialization), no matter if it is on active panel or not. A special case of this problem that is especially troublesome is when the app is started -- DT is not rendered immediately. It seems the drawing starts only when the tab on which it's located is opened (it shows Processing...). In my actual app this introduces couple of seconds lag -- that's why I want to force processing DT while the user is looking at some other tab.

I experimented with including a javascript file that runs $("#dt_test table").DataTable().draw(); on various events but so far without success.

Is there a way to achieve what I am looking for with the aforementioned events or any other method?

like image 604
pieca Avatar asked Jul 10 '18 12:07

pieca


1 Answers

I have come up with two possible solutions.

  1. By using an observer, but with this solution the table will update when switching to the datatable tab, not before.

This was inspired by two videos that are really helpful to better understand how shiny works:

Shiny developer conference 2016 - firs two listed videos

  1. By using the proxy object, this option requires server side processing by setting the appropriate option when rendering the table (see code for this solution below)

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

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

Let me know if this helps....

like image 124
Valter Beaković Avatar answered Oct 02 '22 13:10

Valter Beaković