removed is_na function and replace with rlang::is_lgl_na

R/add_cols.R

@@ -88,7 +88,7 @@ NULL
     onset_to_hosp(num_infected)
 
   # hosp_risk is either numeric or <data.frame> 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)) {

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",

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 `<epidist>` 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,
     <epidist> 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 {

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")