CODEWITHSUNDEEP
rshiny
shaojl7
shaojl7

Reputation: 575

Show a loading bar while in R shiny while sourcing a script

I have a shiny app, that allows user to refresh the data in the front end via a button, and shows the data. My app.R is as below:

library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"

# Define UI for application
ui <- fluidPage(
  actionButton("refresh", "", icon("refresh") ),
  tableOutput("table"),
  uiOutput("slider")
)

# Define server logic required
server <- function(input, output, session) {
  observeEvent(input$refresh,{
    source("updatedata.R")
    showModal(modalDialog(
      title = "", 
      "Data refreshed", 
      easyClose = TRUE,
      footer = NULL
    ))
  })
  # observe the raw file, and refresh if there is change every 5 seconds
  raw <- reactivePoll(5000, session, 
                          checkFunc = function(){
                            if (file.exists(file_name))
                              file.info(file_name)$mtime[1]
                            else
                              ""
                          }, 
                          valueFunc = function(){
                           read.csv(file_name)
                          })
output$table <- renderTable(raw())      
output$slider <- renderUI({
    req(raw())
    tagList(
      # styling slider bar
      tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
                            bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
      sliderInput("date","", 
                  min = min(raw()$v1), 
                  max = max(raw()$v1), 
                  value = max(raw()$v1))
    )

  })

}

# Run the application 
shinyApp(ui = ui, server = server)

I also have another updatedata.R script that does the data update, as below:

file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(x =temp, file = file_name,row.names = FALSE )
Sys.sleep(10)

Whenever the user clicks the refresh button from the front end, it will performs data update. After the data finishes refreshing, there is a window prompt says that the data is refreshed. My problem is that I would also like to have 'some indication' while the data is being refreshed. I tried with shinycssloaders package, and used withSpinner(tableOutput("table")), but this does not meet my needs. Is there any option that I can explore?

Upvotes: 2

Views: 1639

Answers (1)

GoGonzo
GoGonzo

Reputation: 2847

Here is solution for measuring progress every line of source and informing which line is being evaluated. Assuming that your updatedata.R file:

file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(temp,file_name,row.names = FALSE )
Sys.sleep(10)

Shiny app will use withProgress() and incProgress inside the loop - Like in the example and prints which line of source is evaluated. Source is evaluated line-by-line in the loop using eval(parse( text = l[i] ))

library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"

# Define UI for application
ui <- fluidPage(
  actionButton("refresh", "", icon("refresh") ),
  tableOutput("table"),
  uiOutput("slider")
)

# Define server logic required
server <- function(input, output, session) {
  observeEvent(input$refresh,{

    l <- readLines("~/Documents/eclipse_projects/stackoverflow/updatedata.R")
    n <- length(l)
    withProgress(message = 'Making plot', value = 0, {
      for (i in 1:n) {
        eval(parse(text=l[i]))
        incProgress(1/n, detail = paste("Doing part", l[i]))
      }
    })
    showModal(modalDialog(
      title = "", 
      "Data refreshed", 
      easyClose = TRUE,
      footer = NULL
    ))
  })
  # observe the raw file, and refresh if there is change every 5 seconds
  raw <- reactivePoll(5000, session, 
                      checkFunc = function(){
                        if (file.exists(file_name))
                          file.info(file_name)$mtime[1]
                        else
                          ""
                      }, 
                      valueFunc = function(){
                        read.csv(file_name)
                      })
  output$table <- renderTable(raw())      
  output$slider <- renderUI({
    req(raw())
    tagList(
      # styling slider bar
      tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
                             bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
      sliderInput("date","", 
                  min = min(raw()$v1), 
                  max = max(raw()$v1), 
                  value = max(raw()$v1))
    )

  })

}

# Run the application 
shinyApp(ui = ui, server = server)

Alternatively, you can put incProgress() in your source (in the loop or between the lines). Enjoy

Upvotes: 2

Related Questions