Skip to content

Commit 876cf09

Browse files
committed
🔧 report running time
1 parent 398b267 commit 876cf09

File tree

6 files changed

+75
-56
lines changed

6 files changed

+75
-56
lines changed

R/app_server.R

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -77,8 +77,12 @@ app_server <- function(input, output, session) {
7777
alert_active = TRUE,
7878
overwrite_active = FALSE,
7979
crs = "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0",
80-
time = list("hr" = list("initial" = c(0, 0), "final" = c(0, 0)),
81-
"ctsd" = list("initial" = c(0, 0), "final" = c(0, 0))),
80+
time = list(
81+
"upload" = c(0, 0),
82+
"sims" = c(0, 0),
83+
"hr" = c(0, 0),
84+
"ctsd" = c(0, 0),
85+
"total" = c(0, 0)),
8286

8387
highlight_dur = "",
8488
highlight_dti = "",

R/mod_tab_ctsd.R

Lines changed: 23 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -347,22 +347,22 @@ mod_tab_ctsd_ui <- function(id) {
347347
# icon = icon("trash"),
348348
# width = "110px")), br()
349349

350-
) #, # end of box // sdBox_summary
350+
), # end of box // sdBox_summary
351351

352352
## Additional information: --------------------------------------
353353

354-
# shinydashboardPlus::box(
355-
# title = span("Additional information:", class = "ttl-box"),
356-
# id = ns("sdBox_misc"),
357-
# width = NULL,
358-
# solidHeader = FALSE,
359-
#
360-
# verbatimTextOutput(outputId = ns("out_time_sd")),
361-
# verbatimTextOutput(outputId = ns("out_time_sd_new")),
362-
# div(class = "pre-main",
363-
# verbatimTextOutput(outputId = ns("out_time_sd_total")))
364-
#
365-
# ) # end of box
354+
shinydashboardPlus::box(
355+
title = span("Additional information:", class = "ttl-box"),
356+
id = ns("sdBox_misc"),
357+
width = NULL,
358+
solidHeader = FALSE,
359+
360+
verbatimTextOutput(outputId = ns("out_time_sd")),
361+
verbatimTextOutput(outputId = ns("out_time_sd_new")),
362+
div(class = "pre-main",
363+
verbatimTextOutput(outputId = ns("out_time_sd_total")))
364+
365+
) # end of box
366366

367367
) # end of column (bottom)
368368

@@ -1223,7 +1223,7 @@ mod_tab_ctsd_server <- function(id, rv) {
12231223
if ("DOF" %in% names(ctsd)) ctsd <- list(ctsd)
12241224

12251225
time_sd <- difftime(Sys.time(), start_sd, units = "sec")
1226-
rv$sd$time[2] <- rv$sd$time[2] + time_sd[[1]]
1226+
rv$time[["ctsd"]][[1]] <- rv$time[["ctsd"]][[1]] + time_sd[[1]]
12271227

12281228
return(ctsd)
12291229

@@ -1325,7 +1325,6 @@ mod_tab_ctsd_server <- function(id, rv) {
13251325

13261326
for (b in seq_along(boxes)) shinyjs::show(id = boxes[b])
13271327

1328-
rv$time_sd <- c(0,0)
13291328
start <- Sys.time()
13301329

13311330
num_sims <- length(rv$simList) - length(rv$ctsdList)
@@ -1611,8 +1610,7 @@ mod_tab_ctsd_server <- function(id, rv) {
16111610
shinyjs::show(id = "sdBlock_err")
16121611

16131612
time_sd <- difftime(Sys.time(), start, units = "sec")
1614-
rv$time_sd[1] <- rv$time_sd[1] +
1615-
difftime(Sys.time(), start, units = "sec")[[1]]
1613+
rv$time[["ctsd"]][[1]] <- rv$time[["ctsd"]][[1]] + time_sd[[1]]
16161614

16171615
msg_log(
16181616
style = "success",
@@ -2037,7 +2035,7 @@ mod_tab_ctsd_server <- function(id, rv) {
20372035
rv$speedErr_new <- out_err
20382036

20392037
time_sd <- difftime(Sys.time(), start_est, units = "sec")
2040-
rv$sd$time[2] <- rv$sd$time[2] + time_sd[[1]]
2038+
rv$time[["ctsd"]][[2]] <- rv$time[["ctsd"]][[2]] + time_sd[[1]]
20412039

20422040
### Calculating total and mean distance: --------------------------
20432041

@@ -2709,30 +2707,30 @@ mod_tab_ctsd_server <- function(id, rv) {
27092707

27102708
observe({
27112709
shinyjs::show(id = "sdBox_misc")
2712-
}) %>% bindEvent(rv$sd$time[1] > 0)
2710+
}) %>% bindEvent(rv$time[["sd"]] > 0)
27132711

27142712
output$out_time_sd <- renderText({
2715-
req(rv$sd$time[1] > 0)
2713+
req(rv$time[["sd"]][[1]] > 0)
27162714

2717-
out <- fix_unit(rv$sd$time[1], "seconds", convert = TRUE)
2715+
out <- fix_unit(rv$time[["ctsd"]][[1]], "seconds", convert = TRUE)
27182716
paste0("Initial sampling design took approximately ",
27192717
out$value, " ", out$unit, ".")
27202718

27212719
}) # end of renderText, "time_sd"
27222720

27232721
output$out_time_sd_new <- renderText({
2724-
req(rv$sd$time[2] > 0)
2722+
req(rv$time[["sd"]][[2]] > 0)
27252723

2726-
out <- fix_unit(rv$sd$time[2], "seconds", convert = TRUE)
2724+
out <- fix_unit(rv$time[["ctsd"]][[2]], "seconds", convert = TRUE)
27272725
paste0("New sampling design took approximately ",
27282726
out$value, " ", out$unit, ".")
27292727

27302728
}) # end of renderText, "time_sd_new"
27312729

27322730
output$out_time_sd_new <- renderText({
2733-
req(rv$sd$time[1] > 0, rv$sd$ctsdList)
2731+
req(rv$time[["sd"]][[2]] > 0, rv$sd$ctsdList)
27342732

2735-
total_time <- rv$sd$time[1] + rv$sd$time[2]
2733+
total_time <- rv$time[["sd"]][[1]] + rv$time[["sd"]][[2]]
27362734

27372735
out <- fix_unit(total_time, "seconds", convert = TRUE)
27382736
paste0("... In total, this section took approximately",

R/mod_tab_data_select.R

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -547,6 +547,13 @@ mod_tab_data_select_server <- function(id, rv) {
547547
rv$fitList <- NULL
548548
rv$id <- NULL
549549

550+
rv$time <- list(
551+
"upload" = c(0, 0),
552+
"sims" = c(0, 0),
553+
"hr" = c(0, 0),
554+
"ctsd" = c(0, 0),
555+
"total" = c(0, 0))
556+
550557
rv$data_type <- "selected"
551558
index <- rownames(rv$ctmm) %>% match(x = input$sp_selected)
552559
rv$species_common <- rv$ctmm[index, 1]

R/mod_tab_data_upload.R

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -875,6 +875,13 @@ mod_tab_data_upload_server <- function(id, rv) {
875875
rv$svfList <- NULL
876876
rv$id <- NULL
877877

878+
rv$time <- list(
879+
"upload" = c(0, 0),
880+
"sims" = c(0, 0),
881+
"hr" = c(0, 0),
882+
"ctsd" = c(0, 0),
883+
"total" = c(0, 0))
884+
878885
rv$data_type <- "uploaded"
879886

880887
shinyjs::show(id = "uploadBox_viz")
@@ -1035,7 +1042,8 @@ mod_tab_data_upload_server <- function(id, rv) {
10351042

10361043
req(rv$fitList)
10371044
time_fit <- difftime(Sys.time(), start_fit, units = "sec")
1038-
rv$time[1] <- rv$time[1] + time_fit[[1]]
1045+
rv$time[["upload"]][[1]] <-
1046+
rv$time[["upload"]][[1]] + time_fit[[1]]
10391047

10401048
msg_log(
10411049
style = 'success',
@@ -1611,9 +1619,10 @@ mod_tab_data_upload_server <- function(id, rv) {
16111619
# MISC ----------------------------------------------------------------
16121620

16131621
output$upload_time <- renderText({
1614-
req(rv$time)
1622+
req(rv$time[["upload"]][[1]] > 0)
16151623

1616-
out <- fix_unit(rv$time[1], "seconds", convert = TRUE)
1624+
out <- fix_unit(rv$time[["upload"]][[1]],
1625+
"seconds", convert = TRUE)
16171626

16181627
return(paste0("Model fitting took approximately ",
16191628
out$value, " ", out$unit, "."))

R/mod_tab_hrange.R

Lines changed: 20 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -365,18 +365,18 @@ mod_tab_hrange_ui <- function(id) {
365365

366366
## Additional information: --------------------------------------
367367

368-
# shinydashboardPlus::box(
369-
# title = span("Additional information:", class = "ttl-box"),
370-
# id = ns("hrBox_misc"),
371-
# width = NULL,
372-
# solidHeader = FALSE,
373-
#
374-
# verbatimTextOutput(outputId = ns("out_time_hr")),
375-
# verbatimTextOutput(outputId = ns("out_time_hr_new")),
376-
# div(class = "pre-main",
377-
# verbatimTextOutput(outputId = ns("out_time_hr_total")))
378-
#
379-
# ) # end of box
368+
shinydashboardPlus::box(
369+
title = span("Additional information:", class = "ttl-box"),
370+
id = ns("hrBox_misc"),
371+
width = NULL,
372+
solidHeader = FALSE,
373+
374+
verbatimTextOutput(outputId = ns("out_time_hr")),
375+
verbatimTextOutput(outputId = ns("out_time_hr_new")),
376+
div(class = "pre-main",
377+
verbatimTextOutput(outputId = ns("out_time_hr_total")))
378+
379+
) # end of box
380380

381381
) # end of column (bottom)
382382

@@ -1058,7 +1058,6 @@ mod_tab_hrange_server <- function(id, rv) {
10581058

10591059
for (b in 1:length(boxes)) shinyjs::show(id = boxes[b])
10601060

1061-
rv$time_hr <- c(0,0)
10621061
start <- Sys.time()
10631062

10641063
num_sims <- length(rv$simList) - length(rv$akdeList)
@@ -1250,7 +1249,7 @@ mod_tab_hrange_server <- function(id, rv) {
12501249
rv$hrErr <<- rbind(rv$hrErr, out_err_df)
12511250

12521251
time_hr <- difftime(Sys.time(), start, units = "sec")
1253-
rv$time[["hr"]][[1]][1] <- rv$time[["hr"]][[1]][1] + time_hr[[1]]
1252+
rv$time[["hr"]][[1]] <- rv$time[["hr"]][[1]] + time_hr[[1]]
12541253

12551254
msg_log(
12561255
style = "success",
@@ -1633,7 +1632,7 @@ mod_tab_hrange_server <- function(id, rv) {
16331632
rv$is_analyses <- TRUE
16341633
rv$hr$akdeList <- akde_new
16351634
time_hr <- difftime(Sys.time(), start_est, units = "sec")
1636-
rv$time_hr[2] <- rv$time_hr[2] +
1635+
rv$time[["hr"]][[2]] <- rv$time[["hr"]][[2]] +
16371636
difftime(Sys.time(), start, units = "sec")[[1]]
16381637

16391638
msg_log(
@@ -2209,29 +2208,29 @@ mod_tab_hrange_server <- function(id, rv) {
22092208
# MISC ----------------------------------------------------------------
22102209

22112210
output$out_time_hr <- renderText({
2212-
req(rv$time_hr)
2211+
req(rv$time[["hr"]][[1]] > 0)
22132212

2214-
out <- fix_unit(rv$time_hr[1], "seconds", convert = TRUE)
2213+
out <- fix_unit(rv$time[["hr"]][[1]], "seconds", convert = TRUE)
22152214
out_txt <- paste0("Initial sampling design took approximately ",
22162215
out$value, " ", out$unit, ".")
22172216
out_txt
22182217

22192218
}) # end of renderText, "time_hr"
22202219

22212220
output$out_time_hr_new <- renderText({
2222-
req(rv$time_hr, rv$hr$akdeList)
2221+
req(rv$time[["hr"]][[2]] > 0, rv$hr$akdeList)
22232222

2224-
out <- fix_unit(rv$time_hr[2], "seconds", convert = TRUE)
2223+
out <- fix_unit(rv$time[["hr"]][[2]], "seconds", convert = TRUE)
22252224
out_txt <- paste0("New sampling design took approximately ",
22262225
out$value, " ", out$unit, ".")
22272226
out_txt
22282227

22292228
}) # end of renderText, "time_hr_new"
22302229

22312230
output$out_time_hr_total <- renderText({
2232-
req(rv$time_hr, rv$hr$akdeList)
2231+
req(rv$time[["hr"]][[2]] > 0, rv$hr$akdeList)
22332232

2234-
total_time <- rv$time_hr[1] + rv$time_hr[2]
2233+
total_time <- rv$time[["hr"]][[1]] + rv$time[["hr"]][[2]]
22352234

22362235
out <- fix_unit(total_time, "seconds", convert = TRUE)
22372236
out_txt <- paste0("... In total, this section took ",

R/mod_tab_sims.R

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1027,14 +1027,14 @@ mod_tab_sims_server <- function(id, rv) {
10271027
#
10281028
# rv$fitList <- fitting_ctmm()
10291029

1030-
rv$time_sims <- difftime(Sys.time(), start_sim,
1031-
units = "mins")
1030+
time_sims <- difftime(Sys.time(), start_sim, units = "sec")
1031+
rv$time[["sims"]][[1]] <- rv$time[["sims"]][[1]] + time_sims[[1]]
10321032

10331033
# msg_log(
10341034
# style = "success",
10351035
# message = paste0("Model fitting ",
10361036
# msg_success("completed"), "."),
1037-
# run_time = rv$time_sims)
1037+
# run_time = time_sims)
10381038

10391039
shinyjs::enable("simButton_save")
10401040
shinyjs::show(id = "simBox_misc")
@@ -1812,9 +1812,11 @@ mod_tab_sims_server <- function(id, rv) {
18121812
# Display time elapsed:
18131813

18141814
output$console_sims <- renderText({
1815-
req(rv$time_sims)
1815+
req(rv$time[["sims"]][[1]] > 0)
1816+
1817+
time_mins <- "minutes" %#% rv$time[["sims"]][[1]]
18161818
paste0("The simulation took approximately ",
1817-
round(rv$time_sims, 1), " minutes.")
1819+
round(time_mins, 1), " minutes.")
18181820
})
18191821

18201822
}) # end of moduleServer

0 commit comments

Comments
 (0)