See completed application of Remko's solution at the bottom
这个问题是问题How to time reactive function in Shiny app in r的后续问题.
在我的例子中，我想分别计算在我的完整代码的服务器部分中运行的各种函数的时间.这是因为该应用程序需要一些时间才能加载，因为它可以处理超过200万行的数据，我想隔离较慢的功能，以便可能升级到数据.表包.
在下面的可复制代码中，我将用户r2evans在上面链接的相关问题中提供的一个整体解决方案合并到了一起，该解决方案运行良好(计时组件都在下面进行了 comments ).如何将计时器扩展为单独和额外计时函数results()和extractResults()，并将它们添加到文本输出timer？(在更完整的代码中，大约有12个函数在工作).
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(尽管正如ismirsehregal所建议的那样，使用profvis更有意义！).此外，所有与计时器相关的代码都会在下面用#注释...
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)