How to time reactive function in Shiny app in r

Question

I have a function that I would like to time, and then display on the UI how much time it took to execute that function. How can I get the execution time of that function re-actively? I have tried to put the variable in the reactive function, around the function, etc. I just want to time how long it takes for the reactive function to run and then display it. I am trying not to use additional packages.

library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(

  sidebarPanel(
    # User Input Text  Box
    textInput(inputId = "userText",
          label = "",
          placeholder = "Type in a partial sentence here..."),
    verbatimTextOutput(outputId = "textInput", placeholder = TRUE),

    # Show amount of execution time
    verbatimTextOutput(outputId = "timer", placeholder = TRUE)  
))

server <- function(input, output) {

  # Declare Timer variables
  startTime <- Sys.time()
  endTime <- Sys.time()

  # Some function to time: Trivial Paste Function
  textToDisplay <- reactive({
    req(input$userText)
    startTime <- Sys.time()
    textToDisplay <- paste("This is the user input text: ", input$userText)
    endTime <- Sys.time()
    return(textToDisplay)
  })

  # Display pasted text
  output$textInput <- renderText({
    req(input$userText)
    textToDisplay()

  })

  # Display execution time
  output$timer <- renderText({
    req(input$userText)
    paste0("Executed in: ",((endTime - startTime)*1000)," milliseconds")
  })
}

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

The code above does not update or show the proper time difference correctly.

Answer 1

I used an approach that is the combination of your suggestions @r2evans and @divibisan . I used reactiveValues because I think it is user readable and can be extended to other uses very easily. I used system.time as suggested. When the function is run, it updates the reactive values, and a return statement controls returning the appropriate value from the function.

server <- function(input, output) {
  options(digits.secs=2)

  # Declare Timer variables
  rv <- reactiveValues(
    exTime = Sys.time()
  )

  # Trivial Paste Function
  textToDisplay <- reactive({
    req(input$userText)
    t <- system.time({
      textToDisplay <- paste("This is the user input text: ", 
                             input$userText)
      })
    rv$exTime <- t[[3]]
    return(textToDisplay)
  })

  # Display pasted text
  output$textInput <- renderText({
    req(input$userText)
    textToDisplay()
  })

  # Display execution time
  output$timer <- renderText({
    req(input$userText)
    paste0("Executed in: ",((rv$exTime)*1000)," milliseconds")
  })
}

As @divibisan suggested, this will display 0 because the code runs so fast. You can increase the the digits returned from system.time() with options(digits.secs=2), which I added at the top of the server code. For my purposes with the real function, this gave me 10 millisecond precision running in Windows.

Answer 2

I think there is a bit of unnecessary code there. Your definition of startTime and endTime both within server and the individual reactive chunks is confusing (both to you and the readers); most certainly both locations are not required, and since I prefer the use of system.time, I suggest neither location is necessary.

There are two ways to deal with getting two return values (data and elapsed time) from a chunk: (1) return a list, and (2) reactiveValues().

Keeping your ui and shinyApp ...

For the first option (list), the server component becomes:

server <- function(input, output) {
  mydat <- eventReactive(input$userText, {
    req(input$userText)
    tm <- system.time({
      Sys.sleep(runif(1))
      out <- paste("This is the user input text:", sQuote(input$userText))
    })
    list(x=out, elapsed=tm['elapsed'])
  })
  # Display pasted text
  output$textInput <- renderText({
    req(mydat())
    mydat()$x
  })
  # Display execution time
  output$timer <- renderText({
    req(mydat())
    paste0("Executed in: ", round(mydat()$elapsed*1000), " milliseconds")
  })
}

For the second option, try:

server <- function(input, output) {
  times <- reactiveVal()
  mydat <- reactiveVal()
  # operates in side-effect
  observeEvent(input$userText, {
    req(input$userText)
    tm <- system.time({
      Sys.sleep(runif(1))
      out <- paste("This is the user input text:", sQuote(input$userText))
    })
    times(tm['elapsed'])
    mydat(out)
  })
  # Display pasted text
  output$textInput <- renderText({
    req(mydat())
    mydat()
  })
  # Display execution time
  output$timer <- renderText({
    req(times())
    paste0("Executed in: ", round(times()*1000), " milliseconds")
  })
}

(Instead of two reactiveVal() variables, you can also use @divibisan's suggestion to use reactiveValues(), the same end-result.)

Answer 3

Ah, the problem is that startTime and endTime aren't reactive values, so when they change they don't cause renderText to be invalidated and rerun and they don't persist properly outside the reactive expressions.

Just define a reactiveValues object, and make startTime and endTime part of that.

Replace the part where you define timer variables with:

rv <- reactiveValues()

Then, each time you call on startTime and endTime, use rv$startTime and rv$endTime.

You still won't see a result because textToDisplay runs too quickly, but if you make those changes and add Sys.sleep(2) into textToDisplay you'll see that it works properly.