From 67e71027db6eef1d6d8ff36867646e6ed799e73b Mon Sep 17 00:00:00 2001 From: Joshua Lambert Date: Tue, 7 May 2024 11:19:35 +0100 Subject: [PATCH] removed is_na function and replace with rlang::is_lgl_na --- R/add_cols.R | 4 ++-- R/checkers.R | 34 +++++++++++++++++++--------------- R/utils.R | 28 +++++----------------------- man/is_na.Rd | 20 -------------------- tests/testthat/test-utils.R | 16 ---------------- 5 files changed, 26 insertions(+), 76 deletions(-) delete mode 100644 man/is_na.Rd diff --git a/R/add_cols.R b/R/add_cols.R index 53188f7c..d1fac216 100644 --- a/R/add_cols.R +++ b/R/add_cols.R @@ -88,7 +88,7 @@ NULL onset_to_hosp(num_infected) # hosp_risk is either numeric or or NA - if (!is_na(hosp_risk)) { + if (!rlang::is_lgl_na(hosp_risk)) { if (is.numeric(hosp_risk)) { # size is converted to an integer internally in sample() pop_sample <- sample( @@ -138,7 +138,7 @@ NULL # assign deaths using population or age-stratified death risk # if risk is NA then no deaths are assigned apply_death_risk <- function(.data, risk, idx, config) { - if (!is_na(risk)) { + if (!rlang::is_lgl_na(risk)) { # single population risk is a special case of the age-strat risk # convert population risk to data.frame to apply the same operations if (is.numeric(risk)) { diff --git a/R/checkers.R b/R/checkers.R index 61cd4379..524967a5 100644 --- a/R/checkers.R +++ b/R/checkers.R @@ -158,13 +158,14 @@ "The values in the case_type_prob vector must sum to 1" = sum(case_type_probs) == 1, "hosp_risk must be a single numeric or a data.frame" = - is.numeric(hosp_risk) || is.data.frame(hosp_risk) || is_na(hosp_risk), + is.numeric(hosp_risk) || is.data.frame(hosp_risk) || + rlang::is_lgl_na(hosp_risk), "hosp_death_risk must be a single numeric or a data.frame" = is.numeric(hosp_death_risk) || is.data.frame(hosp_death_risk) || - is_na(hosp_death_risk), + rlang::is_lgl_na(hosp_death_risk), "non_hosp_death_risk must be a single numeric or a data.frame" = is.numeric(non_hosp_death_risk) || is.data.frame(non_hosp_death_risk) || - is_na(non_hosp_death_risk) + rlang::is_lgl_na(non_hosp_death_risk) ) if (is.numeric(hosp_risk)) { checkmate::assert_number(hosp_risk, lower = 0, upper = 1) @@ -281,20 +282,20 @@ msg <- character(0) # risks can only be NA when the onset to event is also NA - if (!is_na(onset_to_hosp_eval) && is_na(hosp_risk)) { + if (!rlang::is_lgl_na(onset_to_hosp_eval) && rlang::is_lgl_na(hosp_risk)) { msg <- c(msg, paste( "hosp_risk is set to NA but onset_to_hosp is specified \n", "set hosp_risk to numeric value" )) } - if (!is_na(onset_to_death_eval)) { - if (is_na(hosp_death_risk)) { + if (!rlang::is_lgl_na(onset_to_death_eval)) { + if (rlang::is_lgl_na(hosp_death_risk)) { msg <- c(msg, paste( "hosp_death_risk is set to NA but onset_to_death is specified \n", "set hosp_death_risk to numeric value" )) } - if (is_na(non_hosp_death_risk)) { + if (rlang::is_lgl_na(non_hosp_death_risk)) { msg <- c(msg, paste( "non_hosp_death_risk is set to NA but onset_to_death is specified \n", "set non_hosp_death_risk to numeric value" @@ -309,33 +310,36 @@ ) } - if (is_na(onset_to_hosp_eval) && checkmate::test_number(hosp_risk) || - is_na(onset_to_hosp_eval) && is.data.frame(hosp_risk)) { + if (rlang::is_lgl_na(onset_to_hosp_eval) && + checkmate::test_number(hosp_risk) || + rlang::is_lgl_na(onset_to_hosp_eval) && is.data.frame(hosp_risk)) { msg <- c(msg, paste( "onset_to_hosp is set to NA but hosp_risk is specified \n", "hosp_risk is being ignored, set hosp_risk to NA when", "onset_to_hosp is NA" )) } - if (is_na(onset_to_hosp_eval) && checkmate::test_number(hosp_death_risk) || - is_na(onset_to_hosp_eval) && is.data.frame(hosp_death_risk)) { + if (rlang::is_lgl_na(onset_to_hosp_eval) && + checkmate::test_number(hosp_death_risk) || + rlang::is_lgl_na(onset_to_hosp_eval) && is.data.frame(hosp_death_risk)) { msg <- c(msg, paste( "onset_to_hosp is set to NA but hosp_death_risk is specified \n", "hosp_death_risk is being ignored, set hosp_death_risk to NA when", "onset_to_hosp is NA" )) } - if (is_na(onset_to_death_eval) && checkmate::test_number(hosp_death_risk) || - is_na(onset_to_death_eval) && is.data.frame(hosp_death_risk)) { + if (rlang::is_lgl_na(onset_to_death_eval) && + checkmate::test_number(hosp_death_risk) || + rlang::is_lgl_na(onset_to_death_eval) && is.data.frame(hosp_death_risk)) { msg <- c(msg, paste( "onset_to_death is set to NA but hosp_death_risk is specified \n", "hosp_death_risk is being ignored, set hosp_death_risk to NA when", "onset_to_death is NA" )) } - if (is_na(onset_to_death_eval) && + if (rlang::is_lgl_na(onset_to_death_eval) && checkmate::test_number(non_hosp_death_risk) || - is_na(onset_to_death_eval) && + rlang::is_lgl_na(onset_to_death_eval) && is.data.frame(non_hosp_death_risk)) { msg <- c(msg, paste( "onset_to_death is set to NA but non_hosp_death_risk is specified \n", diff --git a/R/utils.R b/R/utils.R index 17eaea27..c352b7ea 100644 --- a/R/utils.R +++ b/R/utils.R @@ -120,24 +120,6 @@ out } -#' Check if \R object is a single `NA` -#' -#' Check if an \R object is specifically a single logical [`NA`] (i.e. -#' non-vectorised). [`NA_real_`], [`NA_character_`], [`NA_integer_`], -#' [`NA_complex_`] return `FALSE`. -#' -#' @param x An \R object -#' -#' @return A single boolean `logical`. -#' @keywords internal -is_na <- function(x) { - if (length(x) == 1 && is.atomic(x) && is.logical(x)) { - # check is.na() inside if as it warns for closures - return(all(is.na(x))) - } - return(FALSE) -} - #' Convert `` or `NA` to function #' #' @description @@ -167,27 +149,27 @@ as_function <- function(x) { "onset_to_hosp, onset_to_death and onset_to_recovery need to be a function, or NA" = inherits(x$onset_to_hosp, c("function", "epidist")) || - is_na(x$onset_to_hosp) && + rlang::is_lgl_na(x$onset_to_hosp) && inherits(x$onset_to_death, c("function", "epidist")) || - is_na(x$onset_to_death) + rlang::is_lgl_na(x$onset_to_death) ) contact_distribution <- as.function( x$contact_distribution, func_type = "density" ) infect_period <- as.function(x$infect_period, func_type = "generate") - if (is_na(x$onset_to_hosp)) { + if (rlang::is_lgl_na(x$onset_to_hosp)) { # function to generate NA instead of hospitalisation times onset_to_hosp <- function(x) rep(NA, times = x) } else { onset_to_hosp <- as.function(x$onset_to_hosp, func_type = "generate") } - if (is_na(x$onset_to_death)) { + if (rlang::is_lgl_na(x$onset_to_death)) { # function to generate NA instead of death times onset_to_death <- function(x) rep(NA, times = x) } else { onset_to_death <- as.function(x$onset_to_death, func_type = "generate") } - if (is_na(x$onset_to_recovery)) { + if (rlang::is_lgl_na(x$onset_to_recovery)) { # function to generate NA instead of recovery times onset_to_recovery <- function(x) rep(NA, times = x) } else { diff --git a/man/is_na.Rd b/man/is_na.Rd deleted file mode 100644 index 0af2dd7e..00000000 --- a/man/is_na.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{is_na} -\alias{is_na} -\title{Check if \R object is a single \code{NA}} -\usage{ -is_na(x) -} -\arguments{ -\item{x}{An \R object} -} -\value{ -A single boolean \code{logical}. -} -\description{ -Check if an \R object is specifically a single logical \code{\link{NA}} (i.e. -non-vectorised). \code{\link{NA_real_}}, \code{\link{NA_character_}}, \code{\link{NA_integer_}}, -\code{\link{NA_complex_}} return \code{FALSE}. -} -\keyword{internal} diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index a473f844..2d73040a 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,19 +1,3 @@ -test_that("is_na works as expected", { - expect_true(is_na(NA)) - expect_false(is_na(NA_character_)) - expect_false(is_na(NA_complex_)) - expect_false(is_na(NA_integer_)) - expect_false(is_na(NA_real_)) - expect_false(is_na(NULL)) - expect_false(is_na(NaN)) - expect_false(is_na(1)) - expect_false(is_na(1L)) - expect_false(is_na("1")) - expect_false(is_na(c(1, 2, 3))) - expect_false(is_na(list(1, 2, 3))) - expect_false(is_na(as.Date("2020-01-01"))) -}) - test_that(".anonymise works as expected", { set.seed(1) expect_identical(.anonymise("string"), "5dMaH9wQnr")