test timings

inst/dev/test-timings.r

@@ -0,0 +1,128 @@
+library(EpiNow2)
+library(tictoc)
+
+# get example case counts
+reported_cases <- example_confirmed[1:60]
+snapshot_cases <- example_confirmed[81:140]
+bp_cases <- data.table::copy(reported_cases)
+bp_cases <- bp_cases[, breakpoint := ifelse(date == as.Date("2020-03-16"), 1, 0)]
+
+# set generation time
+gt <- list(
+  fixed = generation_time_opts(
+    disease = "SARS-CoV-2", source = "ganyani", fixed = TRUE
+  ),
+  var = generation_time_opts(
+    disease = "SARS-CoV-2", source = "ganyani"
+  ),
+  ar1 = generation_time_opts()
+)
+
+# set delays between infection and case report
+incubation_period <- get_incubation_period(
+ disease = "SARS-CoV-2", source = "lauer"
+)
+reporting_delay <- list(
+  mean = convert_to_logmean(2, 1), mean_sd = 0.1,
+  sd = convert_to_logsd(2, 1), sd_sd = 0.1, max = 10
+)
+
+delays <- list(
+  var = delay_opts(incubation_period, reporting_delay),
+  fixed = delay_opts(incubation_period, reporting_delay, fixed = TRUE),
+  none = delay_opts()
+)
+
+trunc_dist <- trunc_opts(
+  mean = convert_to_logmean(0.5, 0.5), mean_sd = 0.1,
+  sd = convert_to_logsd(0.5, 0.5), sd_sd = 0.1,
+  max = 3
+)
+
+default_options <- list(
+  stan = stan_opts(chains = 1, warmup = 100, samples = 400,
+                   control = list(adapt_delta = 0.95))
+)
+
+test_scenarios <- list(
+  default = list(
+    reported_cases,
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1))
+  ),
+  approximate_gp = list(
+    reported_cases,
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
+    gp = gp_opts(ls_min = 10, basis_prop = 0.1)
+  ),
+  susceptible_depletion = list(
+    reported_cases,
+    rt = rt_opts(
+      prior = list(mean = 2, sd = 0.1),
+      pop = 1000000, future = "latest"
+    )
+  ),
+  truncation = list(
+    reported_cases,
+    truncation = trunc_dist,
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1))
+  ),
+  backcalc = list(
+    reported_cases,
+    rt = NULL,
+    backcalc = backcalc_opts(),
+    obs = obs_opts(scale = list(mean = 0.4, sd = 0.05)),
+    horizon = 0
+  ),
+  later_snapshot = list(
+    snapshot_cases,
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1))
+  ),
+  stationary_rt = list(
+    reported_cases,
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1), gp_on = "R0")
+  ),
+  fixed_rt = list(
+    reported_cases,
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
+    gp = NULL
+  ),
+  breakpoints_only = list(
+    bp_cases,
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1)),
+    gp = NULL
+  ),
+  random_walk = list(
+    rt = rt_opts(prior = list(mean = 2, sd = 0.1), rw = 7),
+    gp = NULL
+  )
+)
+
+rep <- 5
+
+scenarios <- list()
+timings <- list()
+for (gt_scenario in names(gt)) {
+  scenarios[[gt_scenario]] <- list()
+  gt_options <- gt[[gt_scenario]]
+  for (delay_sceanrio in names(delays)) {
+    scenarios[[gt_scenario]][[delay_scenario]] <- list()
+    delay_options <- delays[[gt_scenario]]
+    for (test_secnario in names(test_scenarios)) {
+      test_options <- test_scenarios[[test_scenario]]
+      exec_times <- c()
+      for (run in seq_len(rep)) {
+        tic()
+        scenarios[[gt_scenario]][[delay_scenario]][[test_scenario]] <-
+          do.call(estimate_infections,
+                  c(list(generation_time = gt_options),
+                    list(delays = delay_options),
+                    test_options,
+                    default_options))
+        run_time <- toc()
+        exec_times[run] <- run_time$toc - run_time$tic
+      }
+      scenarios[[gt_scenario]][[delay_scenario]][[test_scenario]]$exec_times <-
+        exec_times
+    }
+  }
+}