How to separately time multiple reactive functions in R Shiny App?

Question

See completed application of Remko's solution at the bottom

This question is a follow on to question How to time reactive function in Shiny app in r.

In my case, I'd like to separately time the various functions operating in the server section of my full code. This is because it is taking some time for the App to load as it works through 2m+ lines of data, and I'd like to isolate the slower functions for possible upgrade to data.table package.

In the reproducible code below, I've incorporated an overall solution offered by user r2evans in the related question linked to above, which works nicely (timing components all commented # below). How would I expand the timer to separately and additionally time my functions results() and extractResults() and add them to text output timer? (In the fuller code this is intended for, there are about 12 functions at work).

library(DT)
library(shiny)
library(dplyr)
library(data.table)

data <- 
  data.frame(
    ID = c(1,1,1,2,2,2,3,3,3),
    Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
    State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X9")
  )

numTransit <- function(x, from=1, to=3){
  setDT(x)
  unique_state <- unique(x$State)
  all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
  dcast(x[, .(from_state = State[from], 
              to_state = State[to]), 
          by = ID]
        [,.N, c("from_state", "to_state")]
        [all_states,on = c("from_state", "to_state")], 
        to_state ~ from_state, value.var = "N"
  )
}

ui <- fluidPage(
  tags$head(tags$style(".datatables .display {margin-left: 0;}")), 
  h4(strong("Transition table inputs:")),
  numericInput("transFrom", "From period:", 1, min = 1, max = 3),
  numericInput("transTo", "To period:", 2, min = 1, max = 3),
  h4(strong("Output transition table:")), 
  DTOutput("resultsDT"),
  h4(strong("Extract of above transition table:")), 
  tableOutput("resultsPlot"),
  
  # Display execution time results:
  verbatimTextOutput(outputId = "timer", placeholder = TRUE)  
)

server <- function(input, output, session) {
  
  # Time keeper 'mydat' object:
  mydat <- eventReactive(input$transTo, {
    req(input$transTo)
    tm <- system.time({
      Sys.sleep(runif(1))
    })
    list(elapsed=tm['elapsed'])
  })
  
  # Display execution time:
  output$timer <- renderText({
    req(mydat())
    paste0("Executed in: ", round(mydat()$elapsed*1000), " milliseconds")
  })
  
  results <- 
    reactive({
      results <- numTransit(data, input$transFrom, input$transTo) %>% 
        replace(is.na(.), 0) %>%
        bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Sum")))
      results <- cbind(results, Sum = rowSums(results[,-1]))
      results %>% 
        mutate(across(-1, ~ .x / .x[length(.x)])) %>% 
        replace(is.na(.), 0) %>% 
        mutate(across(-1, scales::percent_format(accuracy = 0.1)))
    })
  
  extractResults <- 
    reactive({
      extractResults <- 
        data.frame(lapply(results()[1:nrow(results())-1,2:nrow(results())], 
                          function(x) as.numeric(sub("%", "", x))/100))
      row.names(extractResults) <- colnames(extractResults)
      extractResults
    })
  
  output$data <- renderTable(data)
  
  output$resultsDT <- renderDT(server=FALSE, {datatable(data = results())})
  
  output$resultsPlot <- renderTable({extractResults()},rownames=TRUE)

}

shinyApp(ui, server)

Below is the complete application of Remko's solution so we capture cumulative time lapse for each function, separately (notwithstanding that it makes more sense to use profvis as ismirsehregal suggests!). Also, all timer-related code is commented with # below...

library(DT)
library(shiny)
library(dplyr)
library(data.table)

data <- 
  data.frame(
    ID = c(1,1,1,2,2,2,3,3,3),
    Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
    State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X9")
  )

numTransit <- function(x, from=1, to=3){
  setDT(x)
  unique_state <- unique(x$State)
  all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
  dcast(x[, .(from_state = State[from], 
              to_state = State[to]), 
          by = ID]
        [,.N, c("from_state", "to_state")]
        [all_states,on = c("from_state", "to_state")], 
        to_state ~ from_state, value.var = "N"
  )
}

ui <- fluidPage(
  tags$head(tags$style(".datatables .display {margin-left: 0;}")), 
  h4(strong("Transition table inputs:")),
  numericInput("transFrom", "From period:", 1, min = 1, max = 3),
  numericInput("transTo", "To period:", 2, min = 1, max = 3),
  h4(strong("Output transition table:")), 
  DTOutput("resultsDT"),
  h4(strong("Extract of above transition table:")), 
  tableOutput("resultsPlot"),
  
  # Display execution time results:
  verbatimTextOutput(outputId = "timer_results", placeholder = TRUE),
  verbatimTextOutput(outputId = "timer_extractResults", placeholder = TRUE),
  verbatimTextOutput(outputId = "timer_total", placeholder = TRUE)  
)

server <- function(input, output, session) {
  
  # Start timers off at zero
  timer_results <- reactiveVal(0)
  timer_extractResults <- reactiveVal(0)
  timer_total <- reactiveVal(0)
  
  # Display total execution time for all functions:
  output$timer_total <- renderText({
    req(timer_results(),timer_extractResults())
    paste0("Total executed in: ", round(timer_results()*1000) + round(timer_extractResults()*1000), " milliseconds")
  })
  
  # Display results() cumulative execution time:
  output$timer_results <- renderText({
    req(timer_results())
    paste0("results() executed in: ", round(timer_results()*1000), " milliseconds")
  })
  
  results <- reactive({
    tm <- system.time({ # timer
      results <- numTransit(data, input$transFrom, input$transTo) %>% 
        replace(is.na(.), 0) %>%
        bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Sum")))
      results <- cbind(results, Sum = rowSums(results[,-1]))
      
      Sys.sleep(0.25) # timer
      
      results <- results %>% 
        mutate(across(-1, ~ .x / .x[length(.x)])) %>% 
        replace(is.na(.), 0) %>% 
        mutate(across(-1, scales::percent_format(accuracy = 0.1)))
    })
    
    # Timer: without isolate() here you'll get an infinite loop
    isolate(
      timer_results(timer_results() + tm[["elapsed"]])  
    )
    
    results
  })
  
  # Display extractResults() cumulative execution time:
  output$timer_extractResults <- renderText({
    req(timer_extractResults())
    paste0("extractResults() executed in: ", round(timer_extractResults()*1000), " milliseconds")
  })
  
  extractResults <- reactive({
    tm <- system.time({ # Timer
      extractResults <- 
        data.frame(lapply(results()[1:nrow(results())-1,2:nrow(results())], 
                          function(x) as.numeric(sub("%", "", x))/100))
      
      Sys.sleep(0.5) # Timer
      
      row.names(extractResults) <- colnames(extractResults)
    })
    
    # Timer: without isolate() here you'll get an infinite loop
    isolate(
       timer_extractResults(timer_extractResults() + tm[["elapsed"]])  
     )
    
    extractResults
  })
  
  output$data <- renderTable(data)
  
  output$resultsDT <- renderDT(server=FALSE, {datatable(data = results())})
  
  output$resultsPlot <- renderTable({extractResults()},rownames=TRUE)
  
}

shinyApp(ui, server)

Answer 1

Here is one solution using a reactiveVal to store the total time, and increment it within each reactive data computation.

library(DT)
library(shiny)
library(dplyr)
library(data.table)

data <- 
  data.frame(
    ID = c(1,1,1,2,2,2,3,3,3),
    Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
    State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X9")
  )

numTransit <- function(x, from=1, to=3){
  setDT(x)
  unique_state <- unique(x$State)
  all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
  dcast(x[, .(from_state = State[from], 
              to_state = State[to]), 
          by = ID]
        [,.N, c("from_state", "to_state")]
        [all_states,on = c("from_state", "to_state")], 
        to_state ~ from_state, value.var = "N"
  )
}

ui <- fluidPage(
  tags$head(tags$style(".datatables .display {margin-left: 0;}")), 
  h4(strong("Transition table inputs:")),
  numericInput("transFrom", "From period:", 1, min = 1, max = 3),
  numericInput("transTo", "To period:", 2, min = 1, max = 3),
  h4(strong("Output transition table:")), 
  DTOutput("resultsDT"),
  h4(strong("Extract of above transition table:")), 
  tableOutput("resultsPlot"),
  
  # Display execution time results:
  verbatimTextOutput(outputId = "timer", placeholder = TRUE)  
)

server <- function(input, output, session) {
  
  # Start timer off at zero
  timer_total <- reactiveVal(0)
  
  
  # Display execution time:
  output$timer <- renderText({
    req(timer_total())
    paste0("Executed in: ", round(timer_total()*1000), " milliseconds")
  })
  
  results <- reactive({
     tm <- system.time({
       results <- numTransit(data, input$transFrom, input$transTo) %>% 
         replace(is.na(.), 0) %>%
         bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Sum")))
       results <- cbind(results, Sum = rowSums(results[,-1]))
       
      # some extra time here
       Sys.sleep(0.25)
       
       results <- results %>% 
         mutate(across(-1, ~ .x / .x[length(.x)])) %>% 
         replace(is.na(.), 0) %>% 
         mutate(across(-1, scales::percent_format(accuracy = 0.1)))
     })
     
     # without isolate() here you'll get an infinite loop
     isolate(
       timer_total(timer_total() + tm[["elapsed"]])  
     )
     
     
     results
    })
  
  extractResults <- reactive({
    tm <- system.time({
      extractResults <- 
        data.frame(lapply(results()[1:nrow(results())-1,2:nrow(results())], 
                          function(x) as.numeric(sub("%", "", x))/100))
      
      Sys.sleep(0.5)
      
      row.names(extractResults) <- colnames(extractResults)
    })
    
    
    isolate(
      timer_total(timer_total() + tm[["elapsed"]])  
    )
    
    
    extractResults
  })
  
  output$data <- renderTable(data)
  
  output$resultsDT <- renderDT(server=FALSE, {datatable(data = results())})
  
  output$resultsPlot <- renderTable({extractResults()},rownames=TRUE)
  
}

shinyApp(ui, server)