Skip to content

Commit

Permalink
Rename stat_max to stat_threshold to reflect code
Browse files Browse the repository at this point in the history
  • Loading branch information
@jamesmbaazam
jamesmbaazam committed May 15, 2024
1 parent a63c987 commit 99ac279
Show file tree
Hide file tree
Showing 27 changed files with 187 additions and 180 deletions.
2 changes: 1 addition & 1 deletion R/borel.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@ rborel <- function(n, mu, censor_at = Inf) {
n_chains = n,
offspring_dist = rpois,
statistic = "size",
stat_max = censor_at,
stat_threshold = censor_at,
lambda = mu
)
out <- as.numeric(out)
Expand Down
12 changes: 6 additions & 6 deletions R/checks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@
n_chains,
statistic,
offspring_dist,
stat_max,
stat_threshold,
pop,
percent_immune) {
# Input checking
Expand All @@ -41,7 +41,7 @@
# check that arguments related to the statistic are valid
.check_statistic_args(
statistic,
stat_max
stat_threshold
)
checkmate::assert(
is.infinite(pop) ||
Expand All @@ -54,7 +54,7 @@
invisible(NULL)
}

#' Check that the `statistic` and `stat_max` arguments are valid
#' Check that the `statistic` and `stat_threshold` arguments are valid
#'
#' @inheritParams simulate_chains
#' @description
Expand All @@ -64,15 +64,15 @@
#' @return NULL; called for side effects
#' @keywords internal
.check_statistic_args <- function(statistic,
stat_max) {
stat_threshold) {
checkmate::assert_choice(
statistic,
choices = c("size", "length")
)
checkmate::assert(
is.infinite(stat_max),
is.infinite(stat_threshold),
checkmate::check_integerish(
stat_max,
stat_threshold,
lower = 1,
null.ok = FALSE
),
Expand Down
48 changes: 24 additions & 24 deletions R/epichains.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,15 +19,15 @@
n_chains,
statistic,
offspring_dist,
stat_max,
stat_threshold,
track_pop) {
# Assemble the elements of the object
obj <- sim_df
class(obj) <- c("epichains", class(obj))
attr(obj, "n_chains") <- n_chains
attr(obj, "statistic") <- statistic
attr(obj, "offspring_dist") <- offspring_dist
attr(obj, "stat_max") <- stat_max
attr(obj, "stat_threshold") <- stat_threshold
attr(obj, "track_pop") <- track_pop
return(obj)
}
Expand Down Expand Up @@ -59,7 +59,7 @@
offspring_dist,
track_pop,
statistic = c("size", "length"),
stat_max = Inf) {
stat_threshold = Inf) {
# Check that inputs are well specified
checkmate::assert_data_frame(sim_df, min.cols = 3, min.rows = n_chains)
checkmate::assert_integerish(
Expand All @@ -74,16 +74,16 @@
.check_offspring_func_valid(offspring_dist)
checkmate::assert_logical(track_pop, len = 1L)
checkmate::assert(
is.infinite(stat_max),
checkmate::check_integerish(stat_max, lower = 1L)
is.infinite(stat_threshold),
checkmate::check_integerish(stat_threshold, lower = 1L)
)
# Create <epichains> object
epichains <- .new_epichains(
sim_df = sim_df,
n_chains = n_chains,
statistic = statistic,
offspring_dist = offspring_dist,
stat_max = stat_max,
stat_threshold = stat_threshold,
track_pop = track_pop
)

Expand Down Expand Up @@ -115,14 +115,14 @@
n_chains,
statistic,
offspring_dist,
stat_max) {
stat_threshold) {
# Assemble the elements of the object
obj <- chains_summary
class(obj) <- c("epichains_summary", class(chains_summary))
attr(obj, "n_chains") <- n_chains
attr(obj, "statistic") <- statistic
attr(obj, "offspring_dist") <- offspring_dist
attr(obj, "stat_max") <- stat_max
attr(obj, "stat_threshold") <- stat_threshold
return(obj)
}

Expand All @@ -144,7 +144,7 @@
n_chains,
offspring_dist,
statistic = c("size", "length"),
stat_max = Inf) {
stat_threshold = Inf) {
# chain_summary can sometimes contain infinite values, so check
# that finite elements are integerish.
checkmate::check_integerish(
Expand All @@ -162,8 +162,8 @@
statistic <- match.arg(statistic, c("size", "length"))
.check_offspring_func_valid(offspring_dist)
checkmate::assert(
is.infinite(stat_max),
checkmate::check_integerish(stat_max, lower = 1L)
is.infinite(stat_threshold),
checkmate::check_integerish(stat_threshold, lower = 1L)
)

# Create <epichains_summary> object
Expand All @@ -172,7 +172,7 @@
n_chains = n_chains,
statistic = statistic,
offspring_dist = offspring_dist,
stat_max = stat_max
stat_threshold = stat_threshold
)

# Validate the created object
Expand Down Expand Up @@ -201,8 +201,8 @@ print.epichains <- function(x, ...) {
#' prints the number of chains simulated, and the range of
#' the statistic, represented as the maximum (`max_stat`) and minimum
#' (`min_stat`). If the minimum or maximum is infinite, it is represented as
#' `>= stat_max` where `stat_max` is the value of the censoring limit. See
#' `?epichains_summary()` for the definition of `stat_max`.
#' `>= stat_threshold` where `stat_threshold` is the value of the censoring
#' limit. See `?epichains_summary()` for the definition of `stat_threshold`.
#' @param ... Not used.
#' @return Invisibly returns an `<epichains_summary>`. Called for
#' side-effects.
Expand Down Expand Up @@ -296,7 +296,7 @@ format.epichains_summary <- function(x, ...) {
ifelse(
is.infinite(
statistics[["max_stat"]]),
paste0(">=", attr(x, "stat_max")
paste0(">=", attr(x, "stat_threshold")
),
statistics[["max_stat"]]
)
Expand All @@ -306,7 +306,7 @@ format.epichains_summary <- function(x, ...) {
ifelse(
is.infinite(
statistics[["min_stat"]]),
paste0(">=", attr(x, "stat_max")
paste0(">=", attr(x, "stat_threshold")
),
statistics[["min_stat"]]
)
Expand Down Expand Up @@ -344,7 +344,7 @@ format.epichains_summary <- function(x, ...) {
#' percent_immune = 0,
#' statistic = "size",
#' offspring_dist = rnbinom,
#' stat_max = 10,
#' stat_threshold = 10,
#' mu = 2,
#' size = 0.2
#' )
Expand All @@ -360,7 +360,7 @@ format.epichains_summary <- function(x, ...) {
#' percent_immune = 0,
#' statistic = "size",
#' offspring_dist = rnbinom,
#' stat_max = 10,
#' stat_threshold = 10,
#' mu = 2,
#' size = 0.2
#' )
Expand Down Expand Up @@ -392,19 +392,19 @@ summary.epichains <- function(object, ...) {
}
}
# Get other required attributes from passed object
stat_max <- attr(object, "stat_max")
stat_threshold <- attr(object, "stat_threshold")
offspring_dist <- attr(object, "offspring_dist")

# Apply truncation
chain_summaries[chain_summaries >= stat_max] <- Inf
chain_summaries[chain_summaries >= stat_threshold] <- Inf

# Return an <epichains_summary> object
chain_summaries <- .epichains_summary(
chains_summary = chain_summaries,
n_chains = n_chains,
statistic = statistic,
offspring_dist = offspring_dist,
stat_max = stat_max
stat_threshold = stat_threshold
)
return(chain_summaries)
}
Expand Down Expand Up @@ -536,7 +536,7 @@ summary.epichains_summary <- function(object, ...) {
#' n_chains = 10,
#' statistic = "size",
#' offspring_dist = rpois,
#' stat_max = 10,
#' stat_threshold = 10,
#' generation_time = function(n) rep(3, n),
#' lambda = 2
#' )
Expand All @@ -557,7 +557,7 @@ head.epichains <- function(x, ...) {
#' n_chains = 10,
#' statistic = "size",
#' offspring_dist = rpois,
#' stat_max = 10,
#' stat_threshold = 10,
#' generation_time = function(n) rep(3, n),
#' lambda = 2
#' )
Expand Down Expand Up @@ -590,7 +590,7 @@ tail.epichains <- function(x, ...) {
#' n_chains = 10,
#' statistic = "size",
#' offspring_dist = rpois,
#' stat_max = 10,
#' stat_threshold = 10,
#' generation_time = function(n) rep(3, n),
#' lambda = 2
#' )
Expand Down
24 changes: 12 additions & 12 deletions R/likelihood.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@
#' )
#' @export
likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
nsim_obs, obs_prob = 1, log = TRUE, stat_max = Inf,
nsim_obs, obs_prob = 1, log = TRUE, stat_threshold = Inf,
exclude = NULL, individual = FALSE, ...) {
statistic <- match.arg(statistic)

Expand All @@ -63,7 +63,7 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
# check that arguments related to the statistic are valid
.check_statistic_args(
statistic,
stat_max
stat_threshold
)
.check_offspring_func_valid(offspring_dist)
checkmate::assert_number(
Expand All @@ -90,22 +90,22 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
length(chains),
chains, obs_prob
),
stat_max
stat_threshold
), simplify = FALSE)
stat_rep_vect <- unlist(stat_rep_list)
if (!is.finite(stat_max)) {
stat_max <- max(stat_rep_vect) + 1
if (!is.finite(stat_threshold)) {
stat_threshold <- max(stat_rep_vect) + 1
}
} else {
chains[chains >= stat_max] <- stat_max
chains[chains >= stat_threshold] <- stat_threshold
stat_rep_vect <- chains
stat_rep_list <- list(chains)
}

## determine for which sizes to calculate the log-likelihood
## (for true chain size)
if (any(stat_rep_vect == stat_max)) {
calc_sizes <- seq_len(stat_max - 1)
if (any(stat_rep_vect == stat_threshold)) {
calc_sizes <- seq_len(stat_threshold - 1)
} else {
calc_sizes <- unique(c(stat_rep_vect, exclude))
}
Expand Down Expand Up @@ -136,16 +136,16 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
x = calc_sizes,
offspring_dist = offspring_dist,
statistic = statistic,
stat_max = stat_max
stat_threshold = stat_threshold
),
pars
)
)
}

## assign probabilities to stat_max outbreak sizes
if (any(stat_rep_vect == stat_max)) {
likelihoods[stat_max] <- .complementary_logprob(likelihoods)
## assign probabilities to stat_threshold outbreak sizes
if (any(stat_rep_vect == stat_threshold)) {
likelihoods[stat_threshold] <- .complementary_logprob(likelihoods)
}

if (!missing(exclude)) {
Expand Down
Loading

0 comments on commit 99ac279

Please sign in to comment.