Not enough reaction - yet another reactivity question

shiny
#1

(Reproducible code follows). I have some processes that take a while and I want my Shiny app to give some status updates. Here's what I intended for my code to do. After the click of the go button, a file is read and each record of a table is processed (it takes a while for each record to be processed). The actual processing is replaced by a 2 second wait in the code. Before and after each record is processed the table changes and it should be refreshed. Sadly the table doesn't appear until the end of all processing.

Here are some comments / questions about my code:

I make the statusTable a reactive value. The intention is that when this changes, it will trigger an update to the table output.
I use the observe function thinking that if either of the reactive values (input$go or statusTable) change, the code will be executed.

library(DT)
library(dplyr)
library(shiny)

if (interactive()) {
ui <- fluidPage(
  actionButton(inputId = "go", label = "Go"),
  hr(),
  renderPrint("Output below"),
  DT::dataTableOutput("statusTable")
)
server <- function(input, output, session){
  rv <- reactiveValues(statusTable = tibble(Name = character(0), Status = character(0), Result = character(0)))  # make this a reactive value.  
  
  output$statusTable <- DT::renderDataTable(rv$statusTable)
  # observeEvent(statusTable(), { 
  #   output$statusTable <- DT::renderDataTable(rv$statusTable)
  # })
  
  observeEvent(input$go, {
    # in the real world, data would be read from a file.  processing would
      rawData <- tibble(Name = 1:3, y = 4:6, z = 7:9)
      # initial appearance of the statusTable
      rv$statusTable <- tibble(Name = rawData$Name, Status = rep("Queued", nrow(rawData)), Result = rep("na", nrow(rawData)))
      
      for (i in 1:nrow(rawData)) {
        temp  <- rv$statusTable
        temp[i, "Status"] <- "Running"
        rv$statusTable <- temp
        Sys.sleep(2)
        temp  <- rv$statusTable
        temp[i, "Status"] <- "Done"
        temp[i, "Result"] <- as.character(i)
        rv$statusTable <- temp
      }  
  })
  
}

shinyApp(ui, server)
}
#2

Hi,

I have built a solution for this based off an idea in the following post:

library(DT)
library(dplyr)
library(shiny)


ui <- fluidPage(
 actionButton(inputId = "go", label = "Go"),
 hr(),
 renderPrint("Output below"),
 DT::dataTableOutput("statusTable")
)
server <- function(input, output, session){
 
  rv <- reactiveValues(
   statusTable = tibble(Name = 1:3, Status = "Queued", Result = 0),
   i = 0
   ) 
 
 #This is the counter for the "loop"
 observeEvent(input$go, {
   rv$i <- 0
   
   observe({
     isolate({
       rv$i <- rv$i + 1
     })
     
     if (isolate(rv$i <= nrow(rv$statusTable) * 2)){
       
       isolate({
         
         if(rv$i %% 2 == 1){
           rv$statusTable$Status[ceiling(rv$i / 2)] = "Running"
         } else {
           Sys.sleep(2)
           rv$statusTable[ceiling(rv$i / 2), c("Status", "Result")] = 
             list("Finished", sample(1:5, 1))
         }
         
       })
       
       #This function makes sure the environment is flushed and thus can be rendered
       invalidateLater(250, session)
     }
   })
 })
 
 output$statusTable <- DT::renderDataTable(rv$statusTable)
 
}

shinyApp(ui, server)

It does the job, though I must say I find it all a bit convoluted, and maybe someone has a cleaner solution. The key was in using the invalidateLater function.

Hope this helps,
PJ

#3

Very much appreciated. I wish I understood it!

#4

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.