Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Spinner remains visible when rendering DT #686

Closed
DzimitryM opened this issue Apr 8, 2024 · 2 comments
Closed

Spinner remains visible when rendering DT #686

DzimitryM opened this issue Apr 8, 2024 · 2 comments

Comments

@DzimitryM
Copy link

DzimitryM commented Apr 8, 2024

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   
@pvictor
Copy link
Member

pvictor commented Apr 9, 2024

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)

@DzimitryM
Copy link
Author

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}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants