R shiny DT Package processing message and column header load avoidance

Question

I am using shiny to render a very large table using DT package.

Think of this simple piece of code:

library(shiny)
library(DT)

ui <- fluidPage(
  DT::dataTableOutput('mytable')
  )

server <- function(input, output, session) {
  output$mytable <- DT::renderDataTable({
    df <- data.frame(
      x = 1:10000000, y = sample(letters, 10000000, replace = TRUE),
      stringsAsFactors = FALSE
      )
    df %>%
      datatable()
  })
}

shinyApp(ui = ui, server = server)

I want to achieve one of two things:

Server to render NOTHING until the whole table is ready for render (that is, not sit there with column header present and a 'processing' message embedded in that clutter / mess.
Server to start rendering, but have the 'processing' message be visible in clean, centered, isolated space on the UI.

I prefer option #1 with shinycssloaders package and its withSpinner option on the UI side. But, of course, I will be equally happy with #2 as a solution.

Stéphane Laurent · Accepted Answer · 2020-07-15T19:30:35.713

You can do something like this:

library(shiny)
library(DT)

css <- "
#busy { 
  position: absolute;
  z-index: 1000;
  top: 50%;
  left: 50%;
  margin-top: -200px;
  margin-left: -200px;
  display: none;
  background-color: rgba(230,230,230,.8);
  text-align: center;
  padding-top: 20px;
  padding-left: 30px;
  padding-bottom: 40px;
  padding-right: 30px;
  border-radius: 5px;
}"

js <- "
$(document).on('preInit.dt', function(e, settings){
  $('#busy').show();
});
"

initComplete <- JS(
  "function(settings, json){",
  "  $('#busy').hide();",
  "}"
)

ui <- fluidPage(
  
  tags$head(
    tags$style(HTML(css)),
    tags$script(HTML(js))
  ),
  
  tags$div(
    id = "busy", 
    tags$img(
      src = "http://cdn.lowgif.com/full/111c23b7d2d13458-loading-bar-animated-gif-transparent-background-6-gif-images-download.gif",
      width = "400"
    )
  ),
  
  DTOutput("mytable")
  
) 

server <- function(input, output, session) {
  
  output$mytable <- renderDT({
    df <- data.frame(
      x = 1:10000000, y = sample(letters, 10000000, replace = TRUE),
      stringsAsFactors = FALSE
    )
    df %>% datatable(
      options = list(
        initComplete = initComplete
      )
    )
  })
  
}

shinyApp(ui, server)

You can hide the table as well:

js <- "
$(document).on('preInit.dt', function(e, settings){
  $('#busy').show();
  $('#mytable').hide();
});
"

initComplete <- JS(
  "function(settings, json){",
  "  $('#busy').hide();",
  "  $('#mytable').show();",
  "}"
)

You can find better spinners with Google, by typing "spinner gif" and searching among images.

EDIT

Here is a way which works for multiple tables and which doesn't use a GIF image, the spinner is entirely made in CSS.

library(shiny)
library(DT)    

js <- "
$(document).on('preInit.dt', function(e, settings){
  var api = new $.fn.dataTable.Api( settings );
  var $container = $(api.table().node()).closest('.datatables');
  $container.find('>:first-child').css('visibility','hidden');
  $container.prepend('<div class=\"loader\"></div>');
});
"

initComplete <- JS(
  "function(settings, json){",
  "  var $container = $(this.api().table().node()).closest('.datatables');",
  "  $container.find('.loader').remove();",
  "  $container.find('>:first-child').css('visibility', 'visible');",
  "}"
)

css <- "
.loader {
  position: relative;
  top: 60px;
  left: 50%;
  z-index: 1000;
  border: 16px solid #f3f3f3;
  border-radius: 50%;
  border-top: 16px solid #3498db;
  width: 120px;
  height: 120px;
  -webkit-animation: spin 2s linear infinite; /* Safari */
  animation: spin 2s linear infinite;
}

/* Safari */
@-webkit-keyframes spin {
  0% { -webkit-transform: rotate(0deg); }
  100% { -webkit-transform: rotate(360deg); }
}

@keyframes spin {
  0% { transform: rotate(0deg); }
  100% { transform: rotate(360deg); }
}
"

ui <- fluidPage(
  
  tags$head(
    tags$style(HTML(css)),
    tags$script(HTML(js))
  ),
  
  DTOutput("mytable"),
  br(),
  DTOutput("mytable2")
  
) 

server <- function(input, output, session) {
  
  output$mytable <- renderDT({
    df <- data.frame(
      x = 1:1000000, y = sample(letters, 1000000, replace = TRUE),
      stringsAsFactors = FALSE
    )
    df %>% datatable(
      options = list(
        initComplete = initComplete
      )
    )
  })
      
  output$mytable2 <- renderDT({
    df <- data.frame(
      x = 1:1000000, y = sample(letters, 1000000, replace = TRUE),
      stringsAsFactors = FALSE
    )
    df %>% datatable(
      options = list(
        initComplete = initComplete
      )
    )
  })
  
}

shinyApp(ui, server)

If you prefer to use external files for the JavaScript code and the CSS code, save the contents of the js string into a file loader.js and the contents of the css string into a file loader.css; save these two files in the www subfolder of your app, and in the Shiny UI, replace

  tags$head(
    tags$style(HTML(css)),
    tags$script(HTML(js))
  )

with

  tags$head(
    tags$link(href = "loader.css", rel = "stylesheet"),
    tags$script(src = "loader.js")
  )

This works, functionally. Thank you. How do I re-use this across many tables across many UI R files? I assume there is a way to save css and js in some files and reference? — Gopala, Jul 14 '20 at 22:47
@Gopala See my edit for the multiple tables and the external files. I don't understand what you mean by "multiple UI files". — Stéphane Laurent, Jul 15 '20 at 08:58
So, when I have other options in my `datatable` call such as `options = list(info = FALSE, paging = TRUE, searching = TRUE, sort = TRUE, scrollX = TRUE, initComplete = initComplete)`, the final table only displays the first row, and blanks out the rest. Is the JS not embeddable as this with other options? — Gopala, Jul 15 '20 at 15:53
@Gopala Nice catch. I've just edit my answer to update `js` and `initComplete`. Now this works with `scrollX = TRUE`. — Stéphane Laurent, Jul 15 '20 at 19:32

R shiny DT Package processing message and column header load avoidance

1 Answers1

EDIT