如何在 R Shiny App 中分别计时多个反应函数？
How to separately time multiple reactive functions in R Shiny App?
在底部查看 Remko 解决方案的完整应用
此问题是问题 的后续问题。
就我而言，我想分别对在我的完整代码的服务器部分中运行的各种功能进行计时。这是因为应用程序加载 2m+ 行数据需要一些时间，我想隔离较慢的功能以便可能升级到 data.table 包。
在下面的可重现代码中，我结合了用户 r2evans 在上面链接的相关问题中提供的整体解决方案，效果很好（计时组件都在下面注释 #）。我将如何扩展计时器以单独和另外计时我的函数 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)
下面是 Remko 解决方案的完整应用，因此我们分别捕获每个函数的累积时间流逝（尽管按照 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)
这是一个使用 reactiveVal 存储总时间并在每个 reactive 数据计算中递增的解决方案。
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)
在底部查看 Remko 解决方案的完整应用
此问题是问题
就我而言，我想分别对在我的完整代码的服务器部分中运行的各种功能进行计时。这是因为应用程序加载 2m+ 行数据需要一些时间，我想隔离较慢的功能以便可能升级到 data.table 包。
在下面的可重现代码中，我结合了用户 r2evans 在上面链接的相关问题中提供的整体解决方案，效果很好（计时组件都在下面注释 #）。我将如何扩展计时器以单独和另外计时我的函数 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)
下面是 Remko 解决方案的完整应用，因此我们分别捕获每个函数的累积时间流逝（尽管按照 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)
这是一个使用 reactiveVal 存储总时间并在每个 reactive 数据计算中递增的解决方案。
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)