Add input checking

R/borel.r

@@ -1,12 +1,19 @@
 ##' Density of the Borel distribution
 ##'
-##' @param x Vector of integers.
-##' @param mu mu parameter.
+##' @param x Vector of quantiles; integer.
+##' @param mu mu parameter (the poisson mean); non-negative.
 ##' @param log Logical; if TRUE, probabilities p are given as log(p).
 ##' @return Probability mass.
 ##' @author Sebastian Funk
 ##' @export
 dborel <- function(x, mu, log = FALSE) {
+  checkmate::assert_numeric(
+    x, lower = 1, upper = Inf
+  )
+  checkmate::assert_number(
+    mu, lower = 0, finite = TRUE, na.ok = FALSE
+  )
+
   if (x < 1) stop("'x' must be greater than 0")
   ld <- -mu * x + (x - 1) * log(mu * x) - lgamma(x + 1)
   if (!log) ld <- exp(ld)
@@ -17,13 +24,20 @@ dborel <- function(x, mu, log = FALSE) {
 ##'
 ##' Random numbers are generated by simulating from a Poisson branching process
 ##' @param n Number of random variates to generate.
-##' @param mu mu parameter.
+##' @inheritParams dborel
 ##' @param infinite Any number to treat as infinite; simulations will be
 ##' stopped if this number is reached
 ##' @return Vector of random numbers
 ##' @author Sebastian Funk
 ##' @export
 rborel <- function(n, mu, infinite = Inf) {
+  checkmate::assert_number(
+    n, lower = 1, finite = TRUE, na.ok = FALSE
+  )
+  checkmate::assert_number(
+    mu, lower = 0, finite = TRUE, na.ok = FALSE
+  )
+  # Run simulations
   simulate_summary(
     nchains = n,
     offspring_dist = "pois",

R/checks.R

@@ -38,7 +38,7 @@ check_offspring_func_valid <- function(roffspring_name) {
 #'
 #' @keywords internal
 check_serial_valid <- function(serials_dist) {
-  if (!checkmate::test_function(serials_dist)) {
+  if (!checkmate::test_function(serials_dist, nargs = 1)) {
     stop(sprintf(
       "%s %s",
       "The `serials_dist` argument must be a function",

R/likelihood.R

@@ -46,18 +46,35 @@ likelihood <- function(chains, statistic = c("size", "length"), offspring_dist,
                        exclude = NULL, individual = FALSE, ...) {
   statistic <- match.arg(statistic)
 
-  ## checks
+  ## Input checking
+  ## Check nsim_obs when specified
+  if (!missing(nsim_obs)) {
+    checkmate::assert_number(
+      nsim_obs, lower = 1, finite = TRUE, na.ok = FALSE
+    )
+  }
+
+  checkmate::assert_numeric(
+    chains, lower = 0, upper = Inf, any.missing = FALSE
+  )
+  checkmate::assert_character(statistic)
   check_offspring_valid(offspring_dist)
+  checkmate::assert_number(
+    obs_prob, lower = 0, upper = 1, finite = TRUE, na.ok = FALSE
+  )
+  checkmate::assert_number(
+    stat_max, lower = 0, na.ok = FALSE
+  )
   checkmate::assert_logical(
-    log,
-    any.missing = FALSE,
-    all.missing = FALSE,
-    len = 1
+    log, any.missing = FALSE, all.missing = FALSE, len = 1
+  )
+  checkmate::assert_logical(
+    individual, any.missing = FALSE, all.missing = FALSE, len = 1
+  )
+  checkmate::assert_numeric(
+    exclude, null.ok = TRUE
   )
 
-  if (obs_prob <= 0 || obs_prob > 1) {
-    stop("'obs_prob' is a probability and must be between 0 and 1 inclusive")
-  }
   if (obs_prob < 1) {
     if (missing(nsim_obs)) {
       stop("'nsim_obs' must be specified if 'obs_prob' is < 1")

R/simulate.r

@@ -117,7 +117,9 @@ simulate_tree <- function(nchains, statistic = c("size", "length"),
                           tf = Inf, ...) {
   statistic <- match.arg(statistic)
 
+  # Input checking
   check_nchains_valid(nchains = nchains)
+  checkmate::assert_character(statistic)
 
   # check that offspring is properly specified
   check_offspring_valid(offspring_dist)
@@ -126,6 +128,20 @@ simulate_tree <- function(nchains, statistic = c("size", "length"),
   roffspring_name <- paste0("r", offspring_dist)
   check_offspring_func_valid(roffspring_name)
 
+  checkmate::assert_number(
+    stat_max, lower = 0
+  )
+
+  if (!missing(serials_dist)) {
+    check_serial_valid(serials_dist)
+  }
+  checkmate::assert_numeric(
+    t0, lower = 0, finite = TRUE
+  )
+  checkmate::assert_number(
+    tf, lower = 0
+  )
+
   # Gather offspring distribution parameters
   pars <- list(...)
 
@@ -277,7 +293,9 @@ simulate_summary <- function(nchains, statistic = c("size", "length"),
                              stat_max = Inf, ...) {
   statistic <- match.arg(statistic)
 
+  # Input checking
   check_nchains_valid(nchains = nchains)
+  checkmate::assert_character(statistic)
 
   # check that offspring is properly specified
   check_offspring_valid(offspring_dist)
@@ -286,6 +304,10 @@ simulate_summary <- function(nchains, statistic = c("size", "length"),
   roffspring_name <- paste0("r", offspring_dist)
   check_offspring_func_valid(roffspring_name)
 
+  checkmate::assert_number(
+    stat_max, lower = 0
+  )
+
   # Gather offspring distribution parameters
   pars <- list(...)
 
@@ -413,6 +435,24 @@ simulate_tree_from_pop <- function(pop,
                                    ...) {
   offspring_dist <- match.arg(offspring_dist)
 
+  # Input checking
+  checkmate::assert_number(
+    pop, lower = 1, finite = TRUE
+  )
+  checkmate::assert_string(offspring_dist)
+  if (!missing(serials_dist)) {
+    check_serial_valid(serials_dist)
+  }
+  checkmate::assert_number(
+    initial_immune, lower = 0, upper = pop - 1
+  )
+  checkmate::assert_number(
+    t0, lower = 0, finite = TRUE
+  )
+  checkmate::assert_number(
+    tf, lower = 0
+  )
+
   # Gather offspring distribution parameters
   pars <- list(...)
 

R/stat_likelihoods.R

@@ -6,6 +6,13 @@
 #' @author Sebastian Funk
 #' @keywords internal
 pois_size_ll <- function(x, lambda) {
+  checkmate::assert_numeric(
+    x, lower = 0, any.missing = FALSE
+  )
+  checkmate::assert_number(
+    lambda, finite = TRUE, lower = 0
+  )
+
   (x - 1) * log(lambda) - lambda * x + (x - 2) * log(x) - lgamma(x)
 }
 
@@ -22,6 +29,22 @@ pois_size_ll <- function(x, lambda) {
 #' @author Sebastian Funk
 #' @keywords internal
 nbinom_size_ll <- function(x, size, prob, mu) {
+  checkmate::assert_numeric(
+    x, lower = 0, any.missing = FALSE
+  )
+  checkmate::assert_number(
+    size, finite = TRUE, lower = 0
+  )
+  if (!missing(prob)) {
+    checkmate::assert_number(
+      prob, lower = 0, upper = 1
+    )
+  }
+  if (!missing(mu)) {
+    checkmate::assert_number(
+      mu, finite = TRUE, lower = 0
+    )
+  }
   if (!missing(prob)) {
     if (!missing(mu)) stop("'prob' and 'mu' both specified")
     mu <- size * (1 - prob) / prob
@@ -43,6 +66,23 @@ nbinom_size_ll <- function(x, size, prob, mu) {
 #' @author Sebastian Funk
 #' @keywords internal
 gborel_size_ll <- function(x, size, prob, mu) {
+  checkmate::assert_numeric(
+    x, lower = 0, any.missing = FALSE
+  )
+  checkmate::assert_number(
+    size, finite = TRUE, lower = 0
+  )
+  if (!missing(prob)) {
+    checkmate::assert_number(
+      prob, lower = 0, upper = 1
+    )
+  }
+  if (!missing(mu)) {
+    checkmate::assert_number(
+      mu, finite = TRUE, lower = 0
+    )
+  }
+
   if (!missing(prob)) {
     if (!missing(mu)) stop("'prob' and 'mu' both specified")
     mu <- size * (1 - prob) / prob
@@ -60,6 +100,13 @@ gborel_size_ll <- function(x, size, prob, mu) {
 #' @author Sebastian Funk
 #' @keywords internal
 pois_length_ll <- function(x, lambda) {
+  checkmate::assert_numeric(
+    x, lower = 0, any.missing = FALSE
+  )
+  checkmate::assert_number(
+    lambda, finite = TRUE, lower = 0
+  )
+
   ## iterated exponential function
   arg <- exp(lambda * exp(-lambda))
   itex <- 1
@@ -79,6 +126,13 @@ pois_length_ll <- function(x, lambda) {
 #' @author Sebastian Funk
 #' @keywords internal
 geom_length_ll <- function(x, prob) {
+  checkmate::assert_numeric(
+    x, lower = 0, any.missing = FALSE
+  )
+  checkmate::assert_number(
+    prob, lower = 0, upper = 1
+  )
+
   lambda <- 1 / prob
   GkmGkm1 <- (1 - lambda^(x)) / (1 - lambda^(x + 1)) -
     (1 - lambda^(x - 1)) / (1 - lambda^(x))
@@ -114,6 +168,17 @@ geom_length_ll <- function(x, prob) {
 #' )
 offspring_ll <- function(x, offspring_dist, statistic,
                          nsim_offspring = 100, ...) {
+  # Input checking
+  checkmate::assert_numeric(
+    x, lower = 0, any.missing = FALSE
+  )
+  # check that offspring is properly specified
+  check_offspring_valid(offspring_dist)
+  checkmate::assert_character(statistic)
+  checkmate::assert_numeric(
+    nsim_offspring, lower = 1
+  )
+
   # Simulate the chains
   dist <- simulate_summary(
     nchains = nsim_offspring,

R/utils.r

@@ -6,6 +6,10 @@
 #' @author Sebastian Funk
 #' @keywords internal
 complementary_logprob <- function(x) {
+  checkmate::assert_numeric(
+    x, lower = -Inf, upper = 0
+  )
+
   tryCatch(log1p(-sum(exp(x))), error = function(e) -Inf)
 }
 
@@ -43,14 +47,24 @@ rgen_length <- function(n, x, prob) {
 #' Negative binomial random numbers parametrized
 #' in terms of mean and dispersion coefficient
 #' @param n number of samples to draw
-#' @param mn mean of distribution
-#' @param disp dispersion coefficient (var/mean)
+#' @param mn mean of distribution; Must be > 0.
+#' @param disp dispersion coefficient (var/mean); Must be > 1.
 #' @return vector containing the random numbers
 #' @author Flavio Finger
 #' @export
 #' @examples
 #' rnbinom_mean_disp(n = 5, mn = 4, disp = 2)
 rnbinom_mean_disp <- function(n, mn, disp) {
+  checkmate::assert_number(
+    n, lower = 1, finite = TRUE, na.ok = FALSE
+  )
+  checkmate::assert_number(
+    disp, lower = 1, finite = TRUE, na.ok = FALSE
+  )
+  checkmate::assert_number(
+    mn, lower = 1E-100, finite = TRUE, na.ok = FALSE
+  )
+
   size <- mn / (disp - 1)
   stats::rnbinom(n, size = size, mu = mn)
 }

tests/testthat/test-likelihood.R

@@ -168,7 +168,7 @@ test_that("Errors are thrown", {
       lambda = 0.5,
       obs_prob = 3
     ),
-    "must be between 0 and 1"
+    "is not <= 1"
   )
   expect_error(
     likelihood(

tests/testthat/test-utils.R

@@ -98,23 +98,23 @@ test_that("Chain sizes sampler is numerically correct", {
 })
 
 test_that("Reparametrized distributions throw warnings", {
-  expect_warning(
+  expect_error(
     rnbinom_mean_disp(
       n = 5,
       mn = 4,
       disp = 0.9
     ),
-    "NAs produced"
+    "not >= 1"
   )
 })
 
 test_that("Log-probabilities throw warnings", {
-  expect_warning(
+  expect_error(
     complementary_logprob(0.1),
-    "NaNs produced"
+    "is not <= 0"
   )
-  expect_warning(
+  expect_error(
     complementary_logprob(Inf),
-    "NaNs produced"
+    "is not <= 0"
   )
 })

tests/testthat/tests-borel.r

@@ -5,5 +5,5 @@ test_that("We can calculate probabilities and sample", {
 })
 
 test_that("Errors are thrown", {
-  expect_error(dborel(0, 0.5), "greater than 0")
+  expect_error(dborel(0, 0.5), "is not >= 1")
 })