diff --git a/R/function_checkers.R b/R/function_checkers.R new file mode 100644 index 0000000..faec6e2 --- /dev/null +++ b/R/function_checkers.R @@ -0,0 +1,66 @@ +#' @title Check functions passed to exported functions +#' +#' @name function_checkers +#' @rdname function_checkers +#' +#' @description Internal helper function that check whether a function passed as +#' an argument meets the requirements of package methods. +#' +#' `test_fn_req_args()` checks whether the function has only the expected number +#' of required arguments, i.e., arguments without default values. Defaults to +#' checking for a single required argument. +#' +#' `test_fn_num_out()` checks whether a function accepting a numeric vector +#' input returns a numeric vector output of the same length as the input, with +#' finite non-missing values \eqn{\geq} 0.0. +#' +#' @param fn A function. This is expected to be a function evaluating the +#' density of a distribution at numeric values. +#' @param n_req_args The number of required arguments, i.e., arguments without +#' default values. +#' @param n The number of elements over which to evaluate the function `fn`. +#' Defaults to 10, and `fn` is evaluated over `seq(n)`. +#' +#' @return A logical for whether the function `fn` fulfils conditions specified +#' in the respective checks. +#' @keywords internal +test_fn_req_args <- function(fn, n_req_args = 1) { + # NOTE: replacing checkmate::assert_count() + stopifnot( + "`n_req_args` must be a single number" = (is.numeric(n_req_args)) && + (length(n_req_args) == 1), + "`n_req_args` must be finite and non-missing" = (is.finite(n_req_args)) && + (!is.na(n_req_args)), + "`n_req_args` must be a natural number > 0" = (n_req_args > 0) && + (n_req_args %% 1 == 0) + ) + # NOTE: using formals(args(fn)) to allow checking args of builtin primitives + # for which formals(fn) would return NULL and cause the check to error + # NOTE: errors non-informatively for specials such as `if` + is.function(fn) && + Reduce( + x = Map( + function(x, y) { + is.name(x) && y != "..." + }, + formals(args(fn)), names(formals(args(fn))) + ), + f = `+` + ) == n_req_args +} + +#' @name function_checkers +test_fn_num_out <- function(fn, n = 10) { + # NOTE: replacing checkmate::assert_count() + stopifnot( + "`n` must be a single number" = (is.numeric(n)) && (length(n) == 1), + "`n` must be finite and non-missing" = (is.finite(n)) && (!is.na(n)), + "`n` must be a natural number > 0" = (n > 0) && (n %% 1 == 0), + "`fn` must be a function" = is.function(fn) + ) + out <- fn(seq(n)) + + # return logical output of conditions + is.numeric(out) && (length(out) == n) && (!anyNA(out)) && + (all(is.finite(out))) && (all(out > 0.0)) +} diff --git a/man/function_checkers.Rd b/man/function_checkers.Rd new file mode 100644 index 0000000..f499ca7 --- /dev/null +++ b/man/function_checkers.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/function_checkers.R +\name{function_checkers} +\alias{function_checkers} +\alias{test_fn_req_args} +\alias{test_fn_num_out} +\title{Check functions passed to exported functions} +\usage{ +test_fn_req_args(fn, n_req_args = 1) + +test_fn_num_out(fn, n = 10) +} +\arguments{ +\item{fn}{A function. This is expected to be a function evaluating the +density of a distribution at numeric values.} + +\item{n_req_args}{The number of required arguments, i.e., arguments without +default values.} + +\item{n}{The number of elements over which to evaluate the function \code{fn}. +Defaults to 10, and \code{fn} is evaluated over \code{seq(n)}.} +} +\value{ +A logical for whether the function \code{fn} fulfils conditions specified +in the respective checks. +} +\description{ +Internal helper function that check whether a function passed as +an argument meets the requirements of package methods. + +\code{test_fn_req_args()} checks whether the function has only the expected number +of required arguments, i.e., arguments without default values. Defaults to +checking for a single required argument. + +\code{test_fn_num_out()} checks whether a function accepting a numeric vector +input returns a numeric vector output of the same length as the input, with +finite non-missing values \eqn{\geq} 0.0. +} +\keyword{internal} diff --git a/tests/testthat/test-function_checkers.R b/tests/testthat/test-function_checkers.R new file mode 100644 index 0000000..aaa8641 --- /dev/null +++ b/tests/testthat/test-function_checkers.R @@ -0,0 +1,107 @@ +#### Checks on test_fn_req_args() #### +test_that("Function to check N required arguments", { + # Test function to check number of required arguments + expect_true( + test_fn_req_args( + function(x) dgamma(x, 5, 1) + ) + ) + # `+` needs two arguments + expect_true( + test_fn_req_args( + `+`, 2L + ) + ) + expect_false( + test_fn_req_args( + `+`, 1L + ) + ) + expect_false( + test_fn_req_args( + function(x, y, ...) dgamma(x, 5, 1, ...) + y + ) + ) + expect_true( + test_fn_req_args( + dgamma, 2 + ) + ) + + # fails on poorly specified n + expect_error( + test_fn_req_args("dummy_fn", seq(10)), + regexp = "`n_req_args` must be a single number" + ) + expect_error( + test_fn_req_args("dummy_fn", -1), + regexp = "`n_req_args` must be a natural number > 0" + ) + expect_error( + test_fn_req_args("dummy_fn", NA_real_), + regexp = "`n_req_args` must be finite and non-missing" + ) + expect_error( + test_fn_req_args("dummy_fn", Inf), + regexp = "`n_req_args` must be finite and non-missing" + ) + + # expect TRUE when an appropriate primitive is passed + # NOTE: Passes as this primitive has one arg + expect_true( + test_fn_req_args(is.list) + ) + + ## functions with ellipsis + expect_true( + test_fn_req_args( + function(x, ...) dgamma(x, 5, 1, ...) + ) + ) +}) + +#### Test function to check for numeric output #### +test_that("Function to check numeric output", { + # well specified case + expect_true( + test_fn_num_out( + function(x) dgamma(x, 5, 1) + ) + ) + # false on wrong input type + expect_error( + test_fn_num_out("dummy_fn"), + regexp = "`fn` must be a function" + ) + # fails on poorly specified n + expect_error( + test_fn_num_out("dummy_fn", seq(10)), + regexp = "`n` must be a single number" + ) + expect_error( + test_fn_num_out("dummy_fn", -1), + regexp = "`n` must be a natural number > 0" + ) + expect_error( + test_fn_num_out("dummy_fn", NA_real_), + regexp = "`n` must be finite and non-missing" + ) + expect_error( + test_fn_num_out("dummy_fn", Inf), + regexp = "`n` must be finite and non-missing" + ) + # false on wrong return type + expect_false( + test_fn_num_out( + function(x, ...) as.character(dgamma(x, 5, 1, ...)) + ) + ) + # false on wrong return length + fn <- function(x) { + a <- x + 1 + a[-1] + } + expect_false( + test_fn_num_out(fn) + ) +})