From 6266e6b099e144515f3fde0f6b1c438b0fee7a0f Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Mon, 29 Jan 2024 11:56:24 +0000 Subject: [PATCH 1/2] Use dot prefix for internal helper functions --- R/checks.R | 4 ++-- R/epichains.R | 4 ++-- R/helpers.R | 4 ++-- R/likelihood.R | 4 ++-- R/simulate.r | 12 ++++++------ man/{adjust_next_gen.Rd => dot-adjust_next_gen.Rd} | 6 +++--- ...e_valid.Rd => dot-check_generation_time_valid.Rd} | 6 +++--- ...nc_valid.Rd => dot-check_offspring_func_valid.Rd} | 6 +++--- ...ll_name.Rd => dot-construct_offspring_ll_name.Rd} | 6 +++--- ...t_statistic_func.Rd => dot-get_statistic_func.Rd} | 6 +++--- ...update_chain_stat.Rd => dot-update_chain_stat.Rd} | 6 +++--- tests/testthat/test-checks.R | 8 ++++---- tests/testthat/test-helpers.R | 10 +++++----- 13 files changed, 41 insertions(+), 41 deletions(-) rename man/{adjust_next_gen.Rd => dot-adjust_next_gen.Rd} (84%) rename man/{check_generation_time_valid.Rd => dot-check_generation_time_valid.Rd} (80%) rename man/{check_offspring_func_valid.Rd => dot-check_offspring_func_valid.Rd} (79%) rename man/{construct_offspring_ll_name.Rd => dot-construct_offspring_ll_name.Rd} (81%) rename man/{get_statistic_func.Rd => dot-get_statistic_func.Rd} (76%) rename man/{update_chain_stat.Rd => dot-update_chain_stat.Rd} (82%) diff --git a/R/checks.R b/R/checks.R index d3c24308..eda48384 100644 --- a/R/checks.R +++ b/R/checks.R @@ -4,7 +4,7 @@ #' string corresponding to the R distribution function (e.g., "rpois" for #' Poisson. #' @keywords internal -check_offspring_func_valid <- function(roffspring_name) { +.check_offspring_func_valid <- function(roffspring_name) { checkmate::assert( exists(roffspring_name) || checkmate::assert_function(get(roffspring_name)), @@ -18,7 +18,7 @@ check_offspring_func_valid <- function(roffspring_name) { #' @inheritParams simulate_chains #' #' @keywords internal -check_generation_time_valid <- function(generation_time) { +.check_generation_time_valid <- function(generation_time) { checkmate::assert_function(generation_time, nargs = 1) x <- generation_time(10) checkmate::assert_numeric(x, len = 10) diff --git a/R/epichains.R b/R/epichains.R index ed76eb47..bc4a7f63 100644 --- a/R/epichains.R +++ b/R/epichains.R @@ -65,7 +65,7 @@ epichains_tree <- function(tree_df, checkmate::assert_integerish(index_cases, null.ok = TRUE) checkmate::assert_character(statistic, null.ok = TRUE) checkmate::assert_string(offspring_dist) - check_offspring_func_valid(paste0("r", offspring_dist)) + .check_offspring_func_valid(paste0("r", offspring_dist)) checkmate::assert_logical(track_pop) checkmate::assert_number(stat_max, null.ok = TRUE) @@ -143,7 +143,7 @@ epichains_summary <- function(chains_summary, checkmate::assert_integerish(index_cases, null.ok = TRUE) checkmate::assert_character(statistic) checkmate::assert_string(offspring_dist) - check_offspring_func_valid(paste0("r", offspring_dist)) + .check_offspring_func_valid(paste0("r", offspring_dist)) checkmate::assert_number(stat_max, null.ok = TRUE) # Create object diff --git a/R/helpers.R b/R/helpers.R index 0f33fb01..95898d08 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -37,7 +37,7 @@ get_statistic_func <- function(chain_statistic) { #' #' @return an analytical offspring likelihood function #' @keywords internal -construct_offspring_ll_name <- function(offspring_dist, chain_statistic) { +.construct_offspring_ll_name <- function(offspring_dist, chain_statistic) { ll_name <- paste(offspring_dist, chain_statistic, "ll", sep = "_") return(ll_name) } @@ -49,7 +49,7 @@ construct_offspring_ll_name <- function(offspring_dist, chain_statistic) { #' #' @return numeric; adjusted next generation offspring vector #' @keywords internal -adjust_next_gen <- function(next_gen, susc_pop) { +.adjust_next_gen <- function(next_gen, susc_pop) { ## create hypothetical next generation individuals to sample from next_gen_pop <- rep( seq_along(next_gen), diff --git a/R/likelihood.R b/R/likelihood.R index 8bfdddfd..2c7bf55e 100644 --- a/R/likelihood.R +++ b/R/likelihood.R @@ -80,7 +80,7 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist, stop("'nsim_obs' must be specified if 'obs_prob' is < 1") } - statistic_func <- get_statistic_func(statistic) + statistic_func <- .get_statistic_func(statistic) stat_rep_list <- replicate(nsim_obs, pmin( statistic_func( @@ -109,7 +109,7 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist, ## get log-likelihood function as given by offspring_dist and statistic likelihoods <- vector(mode = "numeric") - ll_func <- construct_offspring_ll_name(offspring_dist, statistic) + ll_func <- .construct_offspring_ll_name(offspring_dist, statistic) pars <- as.list(unlist(list(...))) ## converts vectors to lists ## calculate log-likelihoods diff --git a/R/simulate.r b/R/simulate.r index 7ca4a9a8..fb3c9473 100644 --- a/R/simulate.r +++ b/R/simulate.r @@ -150,7 +150,7 @@ simulate_chains <- function(index_cases, "r", offspring_dist ) - check_offspring_func_valid(roffspring_name) + .check_offspring_func_valid(roffspring_name) checkmate::assert( is.infinite(stat_max) || checkmate::assert_integerish(stat_max, lower = 0) @@ -164,7 +164,7 @@ simulate_chains <- function(index_cases, lower = 0, upper = 1 ) if (!missing(generation_time)) { - check_generation_time_valid(generation_time) + .check_generation_time_valid(generation_time) } else if (!missing(tf)) { stop("If `tf` is specified, `generation_time` must be specified too.") } @@ -237,7 +237,7 @@ simulate_chains <- function(index_cases, # Adjust next_gen if the number of offspring is greater than the # susceptible population. if (sum(next_gen) > susc_pop) { - next_gen <- adjust_next_gen( + next_gen <- .adjust_next_gen( next_gen = next_gen, susc_pop = susc_pop ) @@ -250,7 +250,7 @@ simulate_chains <- function(index_cases, # assign offspring sum to indices still being simulated n_offspring[sim] <- tapply(next_gen, parent_ids, sum) # track size/length - stat_track <- update_chain_stat( + stat_track <- .update_chain_stat( stat_type = statistic, stat_latest = stat_track, n_offspring = n_offspring @@ -363,7 +363,7 @@ simulate_summary <- function(index_cases, statistic = c("size", "length"), # check that offspring function exists in base R roffspring_name <- paste0("r", offspring_dist) - check_offspring_func_valid(roffspring_name) + .check_offspring_func_valid(roffspring_name) checkmate::assert_number( stat_max, lower = 0 @@ -400,7 +400,7 @@ simulate_summary <- function(index_cases, statistic = c("size", "length"), n_offspring[sim] <- tapply(next_gen, indices, sum) # track size/length - stat_track <- update_chain_stat( + stat_track <- .update_chain_stat( stat_type = statistic, stat_latest = stat_track, n_offspring = n_offspring diff --git a/man/adjust_next_gen.Rd b/man/dot-adjust_next_gen.Rd similarity index 84% rename from man/adjust_next_gen.Rd rename to man/dot-adjust_next_gen.Rd index 6b100995..f213cfc5 100644 --- a/man/adjust_next_gen.Rd +++ b/man/dot-adjust_next_gen.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/helpers.R -\name{adjust_next_gen} -\alias{adjust_next_gen} +\name{.adjust_next_gen} +\alias{.adjust_next_gen} \title{Adjust next generation vector to match susceptible population size} \usage{ -adjust_next_gen(next_gen, susc_pop) +.adjust_next_gen(next_gen, susc_pop) } \arguments{ \item{next_gen}{numeric; vector of next generation offspring} diff --git a/man/check_generation_time_valid.Rd b/man/dot-check_generation_time_valid.Rd similarity index 80% rename from man/check_generation_time_valid.Rd rename to man/dot-check_generation_time_valid.Rd index 4022766e..e0397f62 100644 --- a/man/check_generation_time_valid.Rd +++ b/man/dot-check_generation_time_valid.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/checks.R -\name{check_generation_time_valid} -\alias{check_generation_time_valid} +\name{.check_generation_time_valid} +\alias{.check_generation_time_valid} \title{Check if the generation_time argument is specified as a function} \usage{ -check_generation_time_valid(generation_time) +.check_generation_time_valid(generation_time) } \arguments{ \item{generation_time}{The generation time function; the name diff --git a/man/check_offspring_func_valid.Rd b/man/dot-check_offspring_func_valid.Rd similarity index 79% rename from man/check_offspring_func_valid.Rd rename to man/dot-check_offspring_func_valid.Rd index b0e5a860..f3435188 100644 --- a/man/check_offspring_func_valid.Rd +++ b/man/dot-check_offspring_func_valid.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/checks.R -\name{check_offspring_func_valid} -\alias{check_offspring_func_valid} +\name{.check_offspring_func_valid} +\alias{.check_offspring_func_valid} \title{Check if constructed random number generator for offspring exists} \usage{ -check_offspring_func_valid(roffspring_name) +.check_offspring_func_valid(roffspring_name) } \arguments{ \item{roffspring_name}{Constructed random offspring sampler: a character diff --git a/man/construct_offspring_ll_name.Rd b/man/dot-construct_offspring_ll_name.Rd similarity index 81% rename from man/construct_offspring_ll_name.Rd rename to man/dot-construct_offspring_ll_name.Rd index ced92db4..046384a0 100644 --- a/man/construct_offspring_ll_name.Rd +++ b/man/dot-construct_offspring_ll_name.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/helpers.R -\name{construct_offspring_ll_name} -\alias{construct_offspring_ll_name} +\name{.construct_offspring_ll_name} +\alias{.construct_offspring_ll_name} \title{Construct name of analytical function for estimating loglikelihood of offspring} \usage{ -construct_offspring_ll_name(offspring_dist, chain_statistic) +.construct_offspring_ll_name(offspring_dist, chain_statistic) } \arguments{ \item{offspring_dist}{Offspring distribution: a \verb{} string diff --git a/man/get_statistic_func.Rd b/man/dot-get_statistic_func.Rd similarity index 76% rename from man/get_statistic_func.Rd rename to man/dot-get_statistic_func.Rd index fe37a9a2..c1cc5bcb 100644 --- a/man/get_statistic_func.Rd +++ b/man/dot-get_statistic_func.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/helpers.R -\name{get_statistic_func} -\alias{get_statistic_func} +\name{.get_statistic_func} +\alias{.get_statistic_func} \title{Return a function for calculating chain statistics} \usage{ -get_statistic_func(chain_statistic) +.get_statistic_func(chain_statistic) } \value{ a function for calculating chain statistics diff --git a/man/update_chain_stat.Rd b/man/dot-update_chain_stat.Rd similarity index 82% rename from man/update_chain_stat.Rd rename to man/dot-update_chain_stat.Rd index 886c723b..a30d52ec 100644 --- a/man/update_chain_stat.Rd +++ b/man/dot-update_chain_stat.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/helpers.R -\name{update_chain_stat} -\alias{update_chain_stat} +\name{.update_chain_stat} +\alias{.update_chain_stat} \title{Determine and update the chain statistic being tracked} \usage{ -update_chain_stat(stat_type, stat_latest, n_offspring) +.update_chain_stat(stat_type, stat_latest, n_offspring) } \arguments{ \item{stat_type}{Chain statistic (size/length) to update.} diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index ed956e79..d9c23a6e 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -1,18 +1,18 @@ test_that("Checks work", { expect_error( - check_offspring_func_valid("rrpois"), + .check_offspring_func_valid("rrpois"), "not found" ) expect_error( - check_generation_time_valid("a"), + .check_generation_time_valid("a"), "Must be a function" ) expect_error( - check_generation_time_valid(function(x) rep("a", 10)), + .check_generation_time_valid(function(x) rep("a", 10)), "numeric" ) expect_error( - check_generation_time_valid(function(x) 3), + .check_generation_time_valid(function(x) 3), "Must have length" ) }) diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index 28d66f0b..601561a1 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -1,6 +1,6 @@ test_that("construct_offspring_ll_name works correctly", { expect_identical( - construct_offspring_ll_name( + .construct_offspring_ll_name( offspring_dist = "pois", chain_statistic = "size" ), @@ -12,7 +12,7 @@ test_that("update_chain_stat works correctly", { stat_latest <- 1 n_offspring <- 2 expect_identical( - update_chain_stat( + .update_chain_stat( stat_type = "size", stat_latest = stat_latest, n_offspring = n_offspring @@ -20,7 +20,7 @@ test_that("update_chain_stat works correctly", { stat_latest + n_offspring ) expect_identical( - update_chain_stat( + .update_chain_stat( stat_type = "length", stat_latest = stat_latest, n_offspring = n_offspring @@ -31,11 +31,11 @@ test_that("update_chain_stat works correctly", { test_that("get_statistic_func works correctly", { expect_identical( - get_statistic_func(chain_statistic = "size"), + .get_statistic_func(chain_statistic = "size"), rbinom_size ) expect_identical( - get_statistic_func(chain_statistic = "length"), + .get_statistic_func(chain_statistic = "length"), rgen_length ) }) From d6421467dfc7e32f6ac29a5e1b6e4ad120208fac Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Mon, 29 Jan 2024 11:56:59 +0000 Subject: [PATCH 2/2] Use switch() instead of ifelse() ladders for choices --- R/helpers.R | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 95898d08..1fa3a5f4 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -5,14 +5,14 @@ #' @param n_offspring A vector of offspring per chain. #' @return A vector of chain statistics (size/length). #' @keywords internal -update_chain_stat <- function(stat_type, stat_latest, n_offspring) { - if (stat_type == "size") { - stat_latest <- stat_latest + n_offspring - } else if (stat_type == "length") { - stat_latest <- stat_latest + pmin(1, n_offspring) - } - - return(stat_latest) +.update_chain_stat <- function(stat_type, stat_latest, n_offspring) { + return( + switch( + stat_type, + size = stat_latest + n_offspring, + length = stat_latest + pmin(1, n_offspring) + ) + ) } #' Return a function for calculating chain statistics @@ -21,13 +21,14 @@ update_chain_stat <- function(stat_type, stat_latest, n_offspring) { #' #' @return a function for calculating chain statistics #' @keywords internal -get_statistic_func <- function(chain_statistic) { - func <- if (chain_statistic == "size") { - rbinom_size - } else if (chain_statistic == "length") { - rgen_length - } - return(func) +.get_statistic_func <- function(chain_statistic) { + return( + switch( + chain_statistic, + size = rbinom_size, + length = rgen_length + ) + ) } #' Construct name of analytical function for estimating loglikelihood of