reduce dependencies

DESCRIPTION

@@ -30,17 +30,10 @@ RoxygenNote: 7.2.3
 Depends:
     R (>= 3.5.0)
 Imports: 
-    magrittr,
-    dplyr,
     data.table,
-    tidyr,
-    furrr,
+    future.apply,
     purrr,
-    ggplot2,
-    sn,
-    tibble,
-    ggrepel,
-    cowplot
+    sn
 Suggests:
     future,
     testthat

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export("%>%")
 export(detect_extinct)
 export(dist_setup)
 export(extinct_prob)
@@ -10,35 +9,12 @@ export(outbreak_setup)
 export(outbreak_step)
 export(parameter_sweep)
 export(scenario_sim)
-importFrom(cowplot,panel_border)
-importFrom(cowplot,theme_minimal_hgrid)
+importFrom(data.table,.SD)
+importFrom(data.table,as.data.table)
 importFrom(data.table,data.table)
+importFrom(data.table,fifelse)
 importFrom(data.table,rbindlist)
-importFrom(dplyr,filter)
-importFrom(dplyr,group_by)
-importFrom(dplyr,left_join)
-importFrom(dplyr,mutate)
-importFrom(dplyr,sample_frac)
-importFrom(dplyr,select)
-importFrom(dplyr,summarise)
-importFrom(dplyr,ungroup)
-importFrom(furrr,future_map)
-importFrom(furrr,future_options)
-importFrom(ggplot2,aes)
-importFrom(ggplot2,coord_flip)
-importFrom(ggplot2,facet_grid)
-importFrom(ggplot2,ggplot)
-importFrom(ggplot2,ggtitle)
-importFrom(ggplot2,labs)
-importFrom(ggplot2,scale_fill_gradient)
-importFrom(ggplot2,scale_x_discrete)
-importFrom(ggplot2,scale_y_continuous)
-importFrom(ggplot2,stat_summary)
-importFrom(ggplot2,theme)
-importFrom(ggplot2,theme_bw)
-importFrom(ggplot2,vars)
-importFrom(ggrepel,geom_label_repel)
-importFrom(magrittr,"%>%")
+importFrom(future.apply,future_lapply)
 importFrom(purrr,map2)
 importFrom(purrr,map2_dbl)
 importFrom(purrr,map_lgl)
@@ -53,7 +29,4 @@ importFrom(stats,median)
 importFrom(stats,quantile)
 importFrom(stats,rbinom)
 importFrom(stats,rweibull)
-importFrom(tibble,has_name)
-importFrom(tidyr,nest)
-importFrom(tidyr,unnest)
 importFrom(utils,data)

R/aux_functions.R

@@ -44,12 +44,8 @@ extinct_prob <- function(outbreak_df_week = NULL, cap_cases  = NULL, week_range
 
   n_sim <- max(outbreak_df_week$sim)
 
-  out <- outbreak_df_week %>%
-    # new variable extinct = 1 if cases in weeks 10-12 all 0, 0 if not
-    detect_extinct(cap_cases, week_range) %>%
-    # number of runs where extinct = TRUE / number of runs
-    .$extinct %>%
-    sum(.) / n_sim
+  extinct_runs <- detect_extinct(outbreak_df_week, cap_cases, week_range)
+  out <-  sum(extinct_runs$extinct) / n_sim
 
   return(out)
 }
@@ -60,19 +56,15 @@ extinct_prob <- function(outbreak_df_week = NULL, cap_cases  = NULL, week_range
 #' @param outbreak_df_week data.table  weekly cases produced by the outbreak model
 #' @param cap_cases integer number of cumulative cases at which the branching process was terminated
 #' @param week_range integer vector giving the (zero indexed) week range to test for whether an extinction occurred.
+#' @importFrom data.table as.data.table fifelse
 #'
 #' @export
-#' @importFrom dplyr group_by filter summarise ungroup
 #'
 detect_extinct <- function(outbreak_df_week  = NULL, cap_cases  = NULL, week_range = 12:16) {
 
-  outbreak_df_week %>%
-    dplyr::group_by(sim) %>% # group by simulation run
-    dplyr::filter(week %in% week_range) %>%
-    dplyr::summarise(extinct =
-                       ifelse(all(weekly_cases == 0 &
-                                    cumulative < cap_cases),
-                              1, 0)) %>%
-    dplyr::ungroup()
-
+  outbreak_df_week <- as.data.table(outbreak_df_week)
+  outbreak_df_week <- outbreak_df_week[week %in% week_range]
+  outbreak_df_week[, list(
+    extinct = fifelse(all(weekly_cases == 0 & cumulative < cap_cases), 1, 0)
+  ), by = sim]
 }

R/parameter_sweep.R

@@ -9,56 +9,55 @@
 #' @param samples Numeric, defaults to 1. The number of samples to take.
 #' @param sim_fn Function, defaults to NULL. The vectorised model simulation function - see the examples
 #' for usage.
-#' @param show_progress Logical, defaults to `TRUE`. Show the progress of the parameter sweep.
-#' @author Sam Abbott
 #'
 #' @return A nested tibble containing the parameters for each scenario and a nested list of output
 #' from `wuhan_sim`.
 #' @export
-#' @importFrom dplyr group_by mutate ungroup sample_frac
-#' @importFrom tibble has_name
-#' @importFrom tidyr nest unnest
-#' @importFrom furrr future_map future_options
+#' @importFrom future.apply future_lapply
 #' @importFrom purrr safely
+#' @importFrom data.table .SD
 #' @examples
 #'
 #'
 #'\dontrun{
-#' library(ringbp)
-#' library(tibble)
+#' library(data.table)
 #'
-#' scenarios <- tidyr::expand_grid(
-#' ## Put parameters that are grouped by disease into this data.frame
-#' delay_group = list(tibble::tibble(
+## Put parameters that are grouped by disease into this data.frame
+#' scenarios <- data.table(expand.grid(
+#' delay_group = list(data.table(
 #'  delay = c("SARS","Wuhan"),
 #'  delay_shape = c(1.651524,2.305172),
 #'  delay_scale = c(4.287786,9.483875)
 #' )),
-#' k_group = list(tibble::tibble(
+#' k_group = list(data.table(
 #'  theta = c("<1%","15%","30%"),
 #'  k = c(1,0.88,0.47)
 #' )),
 #' index_R0 = c(1.5,2.5,3.5),
-#' subclin_R0 = 0,
+#' prop.asym = c(0,  0.1),
 #' control_effectiveness = seq(0,1,0.2),
-#' num.initial.clusters = c(5,20,40)) %>%
-#'  tidyr::unnest("k_group") %>%
-#'  tidyr::unnest("delay_group") %>%
-#'  dplyr::mutate(scenario = 1:dplyr::n())
+#' num.initial.cases = c(5,20,40))
+#'
+#' list_cols <- grep("_group", colnames(scenarios), value = TRUE)
+#' non_list_cols <- setdiff(colnames(scenarios), list_cols)
+#'
+#' expanded_groups <- scenarios[, rbindlist(delay_group), by = c(non_list_cols)]
+#' expanded_k <- scenarios[, rbindlist(k_group), by = c(non_list_cols)]
+#'
+#' scenarios <- merge(
+#'   expanded_groups, expanded_k, by = non_list_cols, allow.cartesian = TRUE
+#' )
+#' scenarios[, scenario :=  1:.N]
 #'
 #' ## Parameterise fixed paramters
 #' sim_with_params <- purrr::partial(ringbp::scenario_sim,
-#'                                  num.initial.cases=1,
 #'                                  cap_max_days = 365,
 #'                                  cap_cases = 5000,
 #'                                  r0isolated = 0,
 #'                                  disp.iso= 1,
 #'                                  disp.subclin = 0.16,
 #'                                  disp.com = 0.16,
-#'                                  mu_ip = 5.8, # incubation period mean
-#'                                  sd_ip = 2.6, # incubation period sd
-#'                                  mu_si = 7.5, # serial interval mean
-#'                                  sd_si = 3.4) # serial interval sd
+#'                                  quarantine = FALSE)
 #'
 #'
 #' ## Default is to run sequntially on a single core
@@ -75,33 +74,33 @@
 #' sweep_results
 #' }
 parameter_sweep <- function(scenarios = NULL, samples = 1,
-                            sim_fn = NULL, show_progress = TRUE) {
+                            sim_fn = NULL) {
 
   safe_sim_fn <- purrr::safely(sim_fn)
 
-  scenario_sims <- scenarios %>%
-    dplyr::group_by(scenario) %>%
-    tidyr::nest() %>%
-    dplyr::ungroup() %>%
-    ##Randomise the order of scenarios - helps share the load across cores
-    dplyr::sample_frac(size = 1, replace = FALSE) %>%
-    dplyr::mutate(sims = furrr::future_map(
-      data,
-      ~ safe_sim_fn(n.sim = samples,
-               num.initial.cases = .$num.initial.cases,
-               r0community = .$index_R0,
-               r0subclin = ifelse(tibble::has_name(scenarios, "subclin_R0"), .$subclin_R0, .$index_R0),
-               k = .$k,
-               delay_shape = .$delay_shape,
-               delay_scale = .$delay_scale,
-               prop.ascertain = .$control_effectiveness,
-               quarantine = .$quarantine,
-               prop.asym = .$prop.asym
-      )[[1]],
-      .progress = show_progress,
-      .options = furrr::furrr_options(scheduling = 20)
-    )) %>%
-    tidyr::unnest(cols = "data")
+  ## create list column
+  scenario_sims <- scenarios[, list(data = list(.SD)), by = scenario]
+  ## Randomise the order of scenarios - helps share the load across cores
+  scenario_sims <- scenario_sims[sample(.N), ]
+  ## Run simulations
+  scenario_sims[, sims := future_lapply(
+    data,
+    \(x) safe_sim_fn(
+      n.sim = samples,
+      num.initial.cases = x$num.initial.cases,
+      r0community = x$index_R0,
+      r0subclin = ifelse(
+        "subclin_R0" %in% names(scenarios), x$subclin_R0, x$index_R0),
+      k = x$k,
+      delay_shape = x$delay_shape,
+      delay_scale = x$delay_scale,
+      prop.ascertain = x$control_effectiveness,
+      quarantine = x$quarantine,
+      prop.asym = x$prop.asym
+    )[[1]],
+    future.scheduling = 20,
+    future.seed = TRUE
+  )]
 
-  return(scenario_sims)
+  return(scenario_sims[])
 }