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

Question

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?

Answer 1

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