Run styler to align with tidyverse style guide

epiverse-trace · Sep 4, 2023 · 3e78208 · 3e78208
1 parent a8f6ef2
commit 3e78208
Show file tree

Hide file tree

Showing 10 changed files with 171 additions and 133 deletions.
diff --git a/R/borel.r b/R/borel.r
@@ -24,10 +24,11 @@ dborel <- function(x, mu, log = FALSE) {
 ##' @author Sebastian Funk
 ##' @export
 rborel <- function(n, mu, infinite = Inf) {
-  simulate_summary(nchains = n,
-                offspring_dist = "pois",
-                statistic = "size",
-                stat_max = infinite,
-                lambda = mu
-                )
+  simulate_summary(
+    nchains = n,
+    offspring_dist = "pois",
+    statistic = "size",
+    stat_max = infinite,
+    lambda = mu
+  )
 }
diff --git a/R/checks.R b/R/checks.R
@@ -24,7 +24,7 @@ check_offspring_valid <- function(offspring_dist) {
 #' @keywords internal
 check_offspring_func_valid <- function(roffspring_name) {
   if (!(exists(roffspring_name)) ||
-      !checkmate::test_function(get(roffspring_name))) {
+        !checkmate::test_function(get(roffspring_name))) {
     stop("Function ", roffspring_name, " does not exist.")
   }
 }

diff --git a/R/epichains.R b/R/epichains.R
@@ -45,22 +45,23 @@ format.epichains <- function(x, ...) {
     )
 
     # Offer more information to view the full dataset
-    writeLines(sprintf("%s %s", "Use `as.data.frame(<object_name>)`",
-                       "to view the full output in the console.")
-               )
-
+    writeLines(sprintf(
+      "%s %s", "Use `as.data.frame(<object_name>)`",
+      "to view the full output in the console."
+    ))
   } else if (is_chains_summary(x)) {
     writeLines(sprintf("`epichains` object \n"))
     print(as.vector(x))
-    writeLines(sprintf("\n Number of chains simulated: %s",
-                chain_info[["unique_chains"]]
-                )
-        )
+    writeLines(sprintf(
+      "\n Number of chains simulated: %s",
+      chain_info[["unique_chains"]]
+    ))
     writeLines(
       c(
-        sprintf("\n Simulated chain %ss: \n",
-                attr(x, "statistic", exact = TRUE)
-                ),
+        sprintf(
+          "\n Simulated chain %ss: \n",
+          attr(x, "statistic", exact = TRUE)
+        ),
         sprintf("Max: %s", chain_info[["max_chain_stat"]]),
         sprintf("Min: %s", chain_info[["min_chain_stat"]])
       )
@@ -86,7 +87,6 @@ summary.epichains <- function(object, ...) {
   chains_ran <- attr(object, "chains", exact = TRUE)
 
   if (is_chains_tree(object)) {
-
     max_time <- max(object$time)
 
     n_unique_ancestors <- length(
@@ -97,25 +97,25 @@ summary.epichains <- function(object, ...) {
 
     # out of summary
     res <- list(
-      chains_ran =  chains_ran,
+      chains_ran = chains_ran,
       max_time = max_time,
       unique_ancestors = n_unique_ancestors,
       max_generation = max_generation
     )
   } else if (is_chains_summary(object)) {
     if (!all(is.infinite(object))) {
-    max_chain_stat <- max(object[!is.infinite(object)])
-    min_chain_stat <- min(object[!is.infinite(object)])
+      max_chain_stat <- max(object[!is.infinite(object)])
+      min_chain_stat <- min(object[!is.infinite(object)])
     } else {
-    max_chain_stat <- min_chain_stat <- Inf
+      max_chain_stat <- min_chain_stat <- Inf
     }
 
     res <- list(
       chain_ran = chains_ran,
       max_chain_stat = max_chain_stat,
       min_chain_stat = min_chain_stat
     )
-    }
+  }
 
   return(res)
 }
@@ -161,7 +161,7 @@ validate_epichains <- function(x) {
     stopifnot(
       "object does not contain the correct columns" =
         c("sim_id", "ancestor", "generation") %in%
-          colnames(x),
+        colnames(x),
       "column `sim_id` must be a numeric" =
         is.numeric(x$sim_id),
       "column `ancestor` must be a numeric" =
@@ -255,9 +255,11 @@ tail.epichains <- function(x, ...) {
 #' @author James M. Azam
 #' @examples
 #' set.seed(123)
-#' chains <- simulate_tree(nchains = 10, statistic = "size",
-#' offspring_dist = "pois", stat_max = 10, serials_sampler = function(x) 3,
-#' lambda = 2)
+#' chains <- simulate_tree(
+#'   nchains = 10, statistic = "size",
+#'   offspring_dist = "pois", stat_max = 10, serials_sampler = function(x) 3,
+#'   lambda = 2
+#' )
 #' chains
 #'
 #' # Aggregate cases per time
@@ -269,10 +271,11 @@ tail.epichains <- function(x, ...) {
 #' # Aggregate cases per both time and generation
 #' aggregate(chains, grouping_var = "both")
 aggregate.epichains <- function(x,
-                                grouping_var = c("time",
-                                                 "generation",
-                                                 "both"
-                                                 ),
+                                grouping_var = c(
+                                  "time",
+                                  "generation",
+                                  "both"
+                                ),
                                 ...) {
   validate_epichains(x)
   # Check that the object is of type "chains_tree"
@@ -288,30 +291,37 @@ aggregate.epichains <- function(x,
 
   out <- if (grouping_var == "time") {
     # Count the number of cases per generation
-    stats::aggregate(list(cases = x$sim_id),
+    stats::aggregate(
+      list(cases = x$sim_id),
       list(time = x$time),
       FUN = NROW
     )
   } else if (grouping_var == "generation") {
     # Count the number of cases per time
-    stats::aggregate(list(cases = x$sim_id),
+    stats::aggregate(
+      list(cases = x$sim_id),
       list(generation = x$generation),
       FUN = NROW
     )
   } else if (grouping_var == "both") {
     # Count the number of cases per time
     list(
-      stats::aggregate(list(cases = x$sim_id),
-                       list(time = x$time),
-                       FUN = NROW),
+      stats::aggregate(
+        list(cases = x$sim_id),
+        list(time = x$time),
+        FUN = NROW
+      ),
       # Count the number of cases per generation
-      stats::aggregate(list(cases = x$sim_id),
-                       list(generation = x$generation),
-                       FUN = NROW)
+      stats::aggregate(
+        list(cases = x$sim_id),
+        list(generation = x$generation),
+        FUN = NROW
+      )
     )
   }
 
-  structure(out,
+  structure(
+    out,
     class = c("epichains_aggregate_df", class(out)),
     chain_type = attributes(x)$chain_type,
     rownames = NULL,

diff --git a/R/likelihood.R b/R/likelihood.R
@@ -25,8 +25,10 @@
 #' @examples
 #' # example of observed chain sizes
 #' chain_sizes <- c(1, 1, 4, 7)
-#' likelihood(chains = chain_sizes, statistic = "size",
-#'  offspring_dist = "pois", nsim_obs = 100, lambda = 0.5)
+#' likelihood(
+#'   chains = chain_sizes, statistic = "size",
+#'   offspring_dist = "pois", nsim_obs = 100, lambda = 0.5
+#' )
 #' @export
 likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
                        nsim_obs, log = TRUE, obs_prob = 1, stat_max = Inf,
@@ -44,14 +46,17 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
 
     sample_func <- get_statistic_func(statistic)
 
-    sampled_x <- replicate(nsim_obs, pmin(sample_func(length(chains),
-                                           chains, obs_prob
-                                           ),
-                               stat_max), simplify = FALSE)
+    sampled_x <- replicate(nsim_obs, pmin(
+      sample_func(
+        length(chains),
+        chains, obs_prob
+      ),
+      stat_max
+    ), simplify = FALSE)
     size_x <- unlist(sampled_x)
     if (!is.finite(stat_max)) {
       stat_max <- max(size_x) + 1
-      }
+    }
   } else {
     chains[chains >= stat_max] <- stat_max
     size_x <- chains

diff --git a/R/simulate.r b/R/simulate.r
@@ -71,9 +71,11 @@
 #' statistic without the tree of infections.
 #' @examples
 #' set.seed(123)
-#' chains <- simulate_tree(nchains = 10, statistic = "size",
-#' offspring_dist = "pois", stat_max = 10, serials_sampler = function(x) 3,
-#' lambda = 2)
+#' chains <- simulate_tree(
+#'   nchains = 10, statistic = "size",
+#'   offspring_dist = "pois", stat_max = 10, serials_sampler = function(x) 3,
+#'   lambda = 2
+#' )
 #' @references
 #'
 #' Lehtinen S, Ashcroft P, Bonhoeffer S. On the relationship
@@ -143,9 +145,11 @@ simulate_tree <- function(nchains, statistic = c("size", "length"),
     n_offspring[sim] <- tapply(next_gen, indices, sum)
 
     # track size/length
-    stat_track <- update_chain_stat(stat_type = statistic,
-                                    stat_latest = stat_track,
-                                    n_offspring = n_offspring)
+    stat_track <- update_chain_stat(
+      stat_type = statistic,
+      stat_latest = stat_track,
+      n_offspring = n_offspring
+    )
 
     # record times/ancestors
     if (sum(n_offspring[sim]) > 0) {
@@ -188,17 +192,17 @@ simulate_tree <- function(nchains, statistic = c("size", "length"),
         sim <- intersect(sim, unique(indices)[current_min_time < tf])
       }
       if (!missing(serials_sampler)) {
-          times <- times[indices %in% sim]
-          }
-        ancestor_ids <- ids[indices %in% sim]
-    }
+        times <- times[indices %in% sim]
+      }
+      ancestor_ids <- ids[indices %in% sim]
     }
+  }
 
   if (!missing(tf)) {
     tree_df <- tree_df[tree_df$time < tf, ]
   }
 
-  #sort by sim_id and ancestor
+  # sort by sim_id and ancestor
   tree_df <- tree_df[order(tree_df$sim_id, tree_df$ancestor), ]
 
   structure(
@@ -219,12 +223,14 @@ simulate_tree <- function(nchains, statistic = c("size", "length"),
 #' @param stat_max A cut off for the chain statistic (size/length) being
 #' computed. Results above the specified value, are set to `Inf`.
 #' @examples
-#' simulate_summary(nchains = 10, statistic = "size", offspring_dist = "pois",
-#' stat_max = 10, lambda = 2)
+#' simulate_summary(
+#'   nchains = 10, statistic = "size", offspring_dist = "pois",
+#'   stat_max = 10, lambda = 2
+#' )
 #' @export
 simulate_summary <- function(nchains, statistic = c("size", "length"),
-                          offspring_dist,
-                          stat_max = Inf, ...) {
+                             offspring_dist,
+                             stat_max = Inf, ...) {
   statistic <- match.arg(statistic)
 
   check_nchains_valid(nchains = nchains)
@@ -258,10 +264,11 @@ simulate_summary <- function(nchains, statistic = c("size", "length"),
     n_offspring[sim] <- tapply(next_gen, indices, sum)
 
     # track size/length
-    stat_track <- update_chain_stat(stat_type = statistic,
-                                    stat_latest = stat_track,
-                                    n_offspring = n_offspring
-                                    )
+    stat_track <- update_chain_stat(
+      stat_type = statistic,
+      stat_latest = stat_track,
+      n_offspring = n_offspring
+    )
 
     ## only continue to simulate chains that offspring and aren't of
     ## stat_max size/length
@@ -325,12 +332,16 @@ simulate_summary <- function(nchains, statistic = c("size", "length"),
 #' @author James M. Azam
 #' @examples
 #' # Simulate with poisson offspring
-#' simulate_tree_from_pop(pop = 100, offspring_dist = "pois",
-#' offspring_mean = 0.5, serial_sampler = function(x) 3)
+#' simulate_tree_from_pop(
+#'   pop = 100, offspring_dist = "pois",
+#'   offspring_mean = 0.5, serial_sampler = function(x) 3
+#' )
 #'
 #' # Simulate with negative binomial offspring
-#' simulate_tree_from_pop(pop = 100, offspring_dist = "nbinom",
-#' offspring_mean = 0.5, offspring_disp = 1.1, serial_sampler = function(x) 3)
+#' simulate_tree_from_pop(
+#'   pop = 100, offspring_dist = "nbinom",
+#'   offspring_mean = 0.5, offspring_disp = 1.1, serial_sampler = function(x) 3
+#' )
 #' @export
 simulate_tree_from_pop <- function(pop,
                                    offspring_dist = c("pois", "nbinom"),
@@ -344,26 +355,26 @@ simulate_tree_from_pop <- function(pop,
 
   if (offspring_dist == "pois") {
     if (!missing(offspring_disp)) {
-      warning(sprintf("%s %s %s",
-                      "'offspring_disp' is not used for",
-                      "poisson offspring distribution.",
-                      "Will be ignored."
-                      )
-              )
+      warning(sprintf(
+        "%s %s %s",
+        "'offspring_disp' is not used for",
+        "poisson offspring distribution.",
+        "Will be ignored."
+      ))
     }
 
     ## using a right truncated poisson distribution
     ## to avoid more cases than susceptibles
     offspring_fun <- get_offspring_func(offspring_dist)
-
   } else if (offspring_dist == "nbinom") {
     if (missing(offspring_disp)) {
       stop(sprintf("%s", "'offspring_disp' must be specified."))
     } else if (offspring_disp <= 1) { ## dispersion coefficient
-      stop(sprintf("%s %s %s",
-                   "Offspring distribution 'nbinom' requires",
-                   "argument 'offspring_disp' > 1.",
-                   "Use 'pois' if there is no overdispersion."
+      stop(sprintf(
+        "%s %s %s",
+        "Offspring distribution 'nbinom' requires",
+        "argument 'offspring_disp' > 1.",
+        "Use 'pois' if there is no overdispersion."
       ))
     }
     offspring_fun <- get_offspring_func(offspring_dist)
@@ -375,7 +386,7 @@ simulate_tree_from_pop <- function(pop,
     ancestor = NA_integer_,
     generation = 1L,
     time = t0,
-    offspring_generated = FALSE #used to track simulation and dropped afterwards
+    offspring_generated = FALSE # tracks simulation and dropped afterwards
   )
 
   susc <- pop - initial_immune - 1L
@@ -384,7 +395,6 @@ simulate_tree_from_pop <- function(pop,
   ## continue if any unsimulated chains have t <= tf
   ## AND there is still susceptibles left
   while (any(tree_df$time[!tree_df$offspring_generated] <= tf) && susc > 0) {
-
     ## select from which case to generate offspring
     t <- min(tree_df$time[!tree_df$offspring_generated]) # lowest unsimulated t
 
@@ -434,7 +444,7 @@ simulate_tree_from_pop <- function(pop,
   ## have been generated in the last generation
   tree_df <- tree_df[tree_df$time <= tf, ]
 
-  #sort by sim_id and ancestor
+  # sort by sim_id and ancestor
   tree_df <- tree_df[order(tree_df$sim_id, tree_df$ancestor), ]
   tree_df$offspring_generated <- NULL