rshinyspinnerselectinputshinycssloaders

How to add a spinner before a selectizeInput has loaded all the choices? [Shiny]


I want to make an app with 2 actionButtons: 1) to submit the changes before loading a selectizeInput and 2) to draw the plot.

I know how to add a spinner after clicking a actionButton but the majority of the cases is added when you want to show the plot. However, is it possible to add a spinner without showing any plot? In this particular case, I want to show a spinner after clicking "Submit" until the selectizeInput from the 'Selection tab' is loaded. As you can see the example that I attach, it takes a bit to load all the choices (since the file has 25000 rows).

image 1

image 2

I already have one spinner after clicking the second actionButton (Show the plot) but I need one more.

I have created an example, but for some reason the plot is not shown in the shiny app and it appears in the window from R (I don't know why but I added the plot just to show you how I put the second spinner. I want a similar one but with the first actionButton.).

library(shiny)
library(shinycssloaders)


ui <- fluidPage(

      titlePanel("My app"),
      
      sidebarLayout(
        sidebarPanel(
          tabsetPanel(
            
            tabPanel("Submit",
                     checkboxInput("log2", "Log2 transformation", value = FALSE),
                     actionButton("submit", "Submit")
            ),
      
      
            tabPanel("Selection",
                     br(),
                     selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
                     actionButton("show_plot", "Show the plot")
            ))
    ),
    mainPanel(
      conditionalPanel(
        condition = "input.show_plot > 0",
        style = "display: none;",
        withSpinner( plotOutput("hist"),
                    type = 5, color = "#0dc5c1", size = 1))

    )
  )
)

server <- function(input, output, session) {
  
  data <- reactive({
    data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
    data[,1] <- as.character(data[,1])
    
    if(input$log2 == TRUE){
      cols <- sapply(data, is.numeric)
      data[cols] <- lapply(data[cols], function(x) log2(x+1))
    }

    return(data)
  })
  
  mylist <- reactive({
    req(data())
    data <- data()
    data <- data[,1]
    return(data)
  })
  
  # This is to generate the choices (gene list) depending on the user's input.
  observeEvent(input$submit, {
    updateSelectizeInput(
      session = session, 
      inputId = "numbers", 
      choices = mylist(), options=list(maxOptions = length(mylist()))
    )
  })
  
  v <- reactiveValues()
  observeEvent(input$show_plot, {
    data <- data()
    v$plot <- plot(x=data[,1], y=data[,2])
  })
  
  
  # If the user didn't choose to see the plot, it won't appear.
  output$hist <- renderPlot({
    req(data())
    if (is.null(v$plot)) return()
    
    if(input$show_plot > 0){
      v$plot
    }

  })
}

Does anyone know how to help me, please?

Thanks very much


Solution

  • It's a little tricky.

    First of all I'd update the selectizeInput on the server side as the warning suggests:

    Warning: The select input "numbers" contains a large number of options; consider using server-side selectize for massively improved performance. See the Details section of the ?selectizeInput help topic.

    Furthermore I switched to ggplot2 regarding the plotOutput - Please see this related post.

    To show the spinner while the selectizeInput is updating choices we'll need to know how long the update takes. This information can be gathered via shiny's JS events - please also see this article.

    Finally, we can show the spinner for a non-existent output, so we are able to control for how long the spinner is shown (see uiOutput("dummyid")):

    library(shiny)
    library(shinycssloaders)
    library(ggplot2)
    
    ui <- fluidPage(
      titlePanel("My app"),
      tags$script(HTML(
        "
         $(document).on('shiny:inputchanged', function(event) {
           if (event.target.id === 'numbers') {
             Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
           }
         });
         $(document).on('shiny:updateinput', function(event) {
           if (event.target.id === 'numbers') {
             Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
           }
         });
        
        "
      )),
      sidebarLayout(
        sidebarPanel(
          tabsetPanel(
            tabPanel("Submit",
                     checkboxInput("log2", "Log2 transformation", value = FALSE),
                     actionButton("submit", "Submit")
            ),
            tabPanel("Selection",
                     br(),
                     selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
                     actionButton("show_plot", "Show the plot")
            ))
        ),
        mainPanel(
          uiOutput("plotProxy")
        )
      )
    )
    
    server <- function(input, output, session) {
      
      previousEvent <- reactiveVal(FALSE)
      choicesReady <- reactiveVal(FALSE)
      submittingData <- reactiveVal(FALSE)
      
      observeEvent(input$selectizeupdate, {
        if(previousEvent() && input$selectizeupdate){
          choicesReady(TRUE)
          submittingData(FALSE)
        } else {
          choicesReady(FALSE)
        }
        previousEvent(input$selectizeupdate)
      })
      
      data <- reactive({
        data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
        
        if(input$log2 == TRUE){
          cols <- sapply(data, is.numeric)
          data[cols] <- lapply(data[cols], function(x) log2(x+1))
        }
        return(data)
      })
      
      mylist <- reactive({
        req(data()[,1])
      })
      
      observeEvent(input$submit, {
        submittingData(TRUE)
        reactivePlotObject(NULL) # reset
        updateSelectizeInput(
          session = session, 
          inputId = "numbers", 
          choices = mylist(), options=list(maxOptions = length(mylist())),
          server = TRUE
        )
      })
      
      reactivePlotObject <- reactiveVal(NULL)
      observeEvent(input$show_plot, {
        reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
      })
      
      output$hist <- renderPlot({
        reactivePlotObject()
      })
      
      output$plotProxy <- renderUI({
        if(submittingData() && !choicesReady()){
          withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
        } else {
          conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
        }
      })
    }
    
    shinyApp(ui, server)
    

    First 100 rows of your example data (dput(head(data, 100)) - your link might be offline some day):

    structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521, 
    69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265, 
    66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916, 
    66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115, 
    68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098, 
    69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368, 
    67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731, 
    65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479, 
    67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376, 
    66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592, 
    68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278, 
    69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947, 
    67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481, 
    67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752, 
    69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
    ), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354, 
    144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516, 
    114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733, 
    137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501, 
    129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536, 
    125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478, 
    106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639, 
    145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839, 
    115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148, 
    128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684, 
    132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351, 
    128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254, 
    121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916, 
    121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457, 
    131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA, 
    100L), class = "data.frame")