dreamRs / shinyWidgets

shinyWidgets : Extend widgets available in shiny

Home Page:https://dreamrs.github.io/shinyWidgets/

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

Spinner remains visible when rendering DT

DzimitryM opened this issue · comments

When using addSpinner(), the spinner remains visible when rendering DT (DataTables). This behavior is inconsistent with the expected behavior observed with plots.

Code to reproduce:

In this example a DT and 2 plots are rendered: the spinner remains visible even after the DataTable is rendered, while the spinners for the plots hide after rendering.

library(shiny)
library(shinyWidgets)
library(DT)

ui <- fluidPage(
  tags$h2("Exemple spinners"),
  actionButton(inputId = "refresh", label = "Refresh", width = "100%"),
  fluidRow(
    column(
      width = 5, offset = 1,
      addSpinner(DTOutput("table1"), spin = "circle", color = "#E41A1C")
    ),
    column(
      width = 5,
      addSpinner(plotOutput("plot1"), spin = "fading-circle", color = "#FFFF33"),
      addSpinner(plotOutput("plot2"), spin = "double-bounce", color = "#A65628")
    )
  )
)

server <- function(input, output, session) {
  
  dat <- reactive({
    input$refresh
    Sys.sleep(3)
    Sys.time()
  })
  
  lapply(
    X = seq_len(2),
    FUN = function(i) {
      output[[paste0("plot", i)]] <- renderPlot({
        dat()
        plot(sin, -pi, i*pi)
      })
    }
  )
  
  output$table1 <- renderDT({
    data <- mtcars[sample(nrow(mtcars), 20), ]
    input$refresh
    datatable(
      data,
      class = "display compact",
      options = list(
        dom = "t",
        iDisplayLength = 10,
        scrollX = TRUE
      )
    )
  })
}

shinyApp(ui, server)

image

Environment: Checked in Chrome and Firefox.
> sessionInfo()
R version 4.2.3 (2023-03-15 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 22631)

Matrix products: default

locale:
[1] LC_COLLATE=English_World.utf8  LC_CTYPE=English_World.utf8    LC_MONETARY=English_World.utf8 LC_NUMERIC=C                  
[5] LC_TIME=English_World.utf8    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] DT_0.33            shinyWidgets_0.8.4 shiny_1.8.1.1     

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.12       rstudioapi_0.16.0 magrittr_2.0.3    xtable_1.8-4      R6_2.5.1          rlang_1.1.3       fastmap_1.1.1     tools_4.2.3      
 [9] cli_3.6.2         jquerylib_0.1.4   htmltools_0.5.8   crosstalk_1.2.1   yaml_2.3.8        digest_0.6.35     lifecycle_1.0.4   later_1.3.2      
[17] sass_0.4.9        htmlwidgets_1.6.4 promises_1.2.1    memoise_2.0.1     cachem_1.0.8      mime_0.12         compiler_4.2.3    bslib_0.7.0      
[25] jsonlite_1.8.8    httpuv_1.6.15   

Hello,

That's because the datatable backgound is transparent, you can change it with some CSS:

tags$style(".datatables {min-height: 320px; background: #FFF;}")

Note that I've better to this function in package {shinybusy}, e.g. :

library(shiny)
library(shinybusy)
library(DT)

ui <- fluidPage(
  tags$h2("Exemple spinners"),
  
  actionButton(inputId = "refresh", label = "Refresh", width = "100%"),
  fluidRow(
    column(
      width = 5, offset = 1,
      block_output(DTOutput("table1"), type = "circle", svgColor = "#E41A1C", minHeight = "300px")
    ),
    column(
      width = 5,
      block_output(plotOutput("plot1"), type = "hourglass", backgroundColor  = "#FFFF33", messageColor = "#3ADF00", svgColor = "#3ADF00"),
      block_output(plotOutput("plot2"), type = "arrows", svgColor = "#A65628")
    )
  )
)

server <- function(input, output, session) {
  
  dat <- reactive({
    input$refresh
    Sys.sleep(3)
    Sys.time()
  })
  
  lapply(
    X = seq_len(2),
    FUN = function(i) {
      output[[paste0("plot", i)]] <- renderPlot({
        dat()
        plot(sin, -pi, i*pi)
      })
    }
  )
  
  output$table1 <- renderDT({
    data <- mtcars[sample(nrow(mtcars), 20), ]
    input$refresh
    datatable(
      data,
      class = "display compact",
      options = list(
        dom = "t",
        iDisplayLength = 10,
        scrollX = TRUE
      )
    )
  })
}

shinyApp(ui, server)

Thanks so much @pvictor , this is a great workaround to set a background in CSS.
Also, thanks for the hint to use a lighter alternative {shinybusy}