如何在 r 中的 Shiny 应用程序中计时反应功能

Question

我有一个想要计时的函数，然后在 UI 上显示执行该函数所花费的时间。如何重新获得该函数的执行时间？我试图将变量放在反应函数中，函数周围等。我只想计算反应函数运行然后显示它需要多长时间。我尽量不使用额外的包。

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)

上面的代码没有正确更新或显示正确的时差。

Answer 1

啊，问题是 startTime 和 endTime 不是响应式值，因此当它们更改时，它们不会导致 renderText 无效并重新运行，并且它们不会在响应式表达式之外正确保留.

只需定义一个reactiveValues 对象，然后将startTime 和endTime 作为其中的一部分。

将定义计时器变量的部分替换为：

rv <- reactiveValues()

然后，每次调用startTime 和endTime，使用rv$startTime 和rv$endTime。

您仍然看不到结果，因为textToDisplay 运行得太快了，但是如果您进行这些更改并将Sys.sleep(2) 添加到textToDisplay 中，您会发现它可以正常工作。

Answer 2

我认为那里有一些不必要的代码。您在server 和各个反应块中对startTime 和endTime 的定义令人困惑（对您和读者而言）；毫无疑问，这两个位置都不是必需的，因为我更喜欢使用system.time，所以我建议这两个位置都不是必需的。

有两种方法可以处理从一个块中获取两个返回值（数据和经过的时间）：（1）返回一个list，和（2）reactiveValues()。

保留您的 ui 和 shinyApp ...

对于第一个选项 (list)，server 组件变为：

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")
  })
}

对于第二个选项，请尝试：

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")
  })
}

（除了两个reactiveVal()变量，你也可以使用@divibisan的建议使用reactiveValues()，最终结果相同。）

Answer 3

我使用了一种结合您的建议 @r2evans 和 @divibisan 的方法。我使用了 reactiveValues，因为我认为它是用户可读的，并且可以很容易地扩展到其他用途。我按照建议使用了 system.time 。当函数运行时，它会更新响应值，并且 return 语句控制从函数返回适当的值。

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")
  })
}

正如@divibisan 所建议的，这将显示 0，因为代码运行得非常快。您可以使用我在服务器代码顶部添加的options(digits.secs=2) 增加从system.time() 返回的数字。就我的实际功能而言，这给了我在 Windows 中运行的 10 毫秒精度。