Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Replace is_na() with rlang::is_lgl_na() #111

Merged
merged 1 commit into from
May 7, 2024
Merged

Replace is_na() with rlang::is_lgl_na() #111

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions R/add_cols.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down Expand Up @@ -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)) {
Expand Down
34 changes: 19 additions & 15 deletions R/checkers.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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"
Expand All @@ -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",
Expand Down
28 changes: 5 additions & 23 deletions R/utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 {
Expand Down
20 changes: 0 additions & 20 deletions man/is_na.Rd
View file
Open in desktop

This file was deleted.

16 changes: 0 additions & 16 deletions tests/testthat/test-utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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")
Expand Down
Loading