From 3018fb87a9a87f2d746a0d2fb083f26a515a8af0 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Wed, 17 May 2023 22:12:10 +0200 Subject: [PATCH] `icu_exclude` in `first_isolate()`, fixes #110 --- DESCRIPTION | 4 +-- NEWS.md | 9 ++++--- R/first_isolate.R | 65 ++++++++++++++++++++--------------------------- 3 files changed, 35 insertions(+), 43 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 93235242..c9dff954 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.0.0.9015 -Date: 2023-05-12 +Version: 2.0.0.9018 +Date: 2023-05-17 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) data analysis and to work with microbial and antimicrobial properties by diff --git a/NEWS.md b/NEWS.md index d8bfedf6..0dd1195f 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,16 +1,17 @@ -# AMR 2.0.0.9015 +# AMR 2.0.0.9018 ## Changed * Added oxygen tolerance to over 25,000 bacteria in the `microorganisms` data set * Added `mo_oxygen_tolerance()` to retrieve the values * Added `mo_is_anaerobic()` to determine which species are obligate anaerobic bacteria * Added LPSN and GBIF identifiers, and oxygen tolerance to `mo_info()` -* formatting fix for `sir_interpretation_history()` -* Fixed some WHONET codes for microorganisms and consequently a couple of entries in `clinical_breakpoints` +* Added SAS Transport files (file extension `.xpt`) to [our download page](https://msberends.github.io/AMR/articles/datasets.html) to use in SAS software * Added microbial codes for Gram-negative/positive anaerobic bacteria * `mo_rank()` now returns `NA` for 'unknown' microorganisms (`B_ANAER`, `B_ANAER-NEG`, `B_ANAER-POS`, `B_GRAMN`, `B_GRAMP`, `F_FUNGUS`, `F_YEAST`, and `UNKNOWN`) +* Fixed formatting for `sir_interpretation_history()` +* Fixed some WHONET codes for microorganisms and consequently a couple of entries in `clinical_breakpoints` * Fixed a bug for `as.mo()` that led to coercion of `NA` values when using custom microorganism codes -* Added SAS Transport files (file extension `.xpt`) to [our download page](https://msberends.github.io/AMR/articles/datasets.html) to use in SAS software +* Fixed usage of `icu_exclude` in `first_isolates()` # AMR 2.0.0 diff --git a/R/first_isolate.R b/R/first_isolate.R index b04a613a..1283df01 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -191,13 +191,13 @@ first_isolate <- function(x = NULL, } meet_criteria(col_specimen, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) if (is.logical(col_icu)) { - meet_criteria(col_icu, allow_class = "logical", has_length = c(1, nrow(x)), allow_NULL = TRUE) - if (length(col_icu) == 1) { - col_icu <- rep(col_icu, nrow(x)) - } - } else { + meet_criteria(col_icu, allow_class = "logical", has_length = c(1, nrow(x)), allow_NA = TRUE) + x$newvar_is_icu <- col_icu + } else if (!is.null(col_icu)) { meet_criteria(col_icu, allow_class = c("character", "logical"), has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) - col_icu <- x[, col_icu, drop = TRUE] + x$newvar_is_icu <- x[, col_icu, drop = TRUE] + } else { + x$newvar_is_icu <- NA_real_ } # method method <- coerce_method(method) @@ -251,14 +251,13 @@ first_isolate <- function(x = NULL, "Determining first isolates ", ifelse(method %in% c("episode-based", "phenotype-based"), ifelse(is.infinite(episode_days), - "without a specified episode length", - paste("using an episode length of", episode_days, "days") + paste(font_bold("without"), " a specified episode length"), + paste("using an episode length of", font_bold(paste(episode_days, "days"))) ), "" ) ), - as_note = FALSE, - add_fn = font_black + add_fn = font_red ) } @@ -358,8 +357,7 @@ first_isolate <- function(x = NULL, # remove testcodes if (!is.null(testcodes_exclude) && isTRUE(info) && message_not_thrown_before("first_isolate", "excludingtestcodes")) { message_("Excluding test codes: ", vector_and(testcodes_exclude, quotes = TRUE), - add_fn = font_black, - as_note = FALSE + add_fn = font_red ) } @@ -372,8 +370,7 @@ first_isolate <- function(x = NULL, check_columns_existance(col_specimen, x) if (isTRUE(info) && message_not_thrown_before("first_isolate", "excludingspecimen")) { message_("Excluding other than specimen group '", specimen_group, "'", - add_fn = font_black, - as_note = FALSE + add_fn = font_red ) } } @@ -455,15 +452,13 @@ first_isolate <- function(x = NULL, message_("Basing inclusion on key antimicrobials, ", ifelse(ignore_I == FALSE, "not ", ""), "ignoring I", - add_fn = font_black, - as_note = FALSE + add_fn = font_red ) } if (type == "points") { message_("Basing inclusion on all antimicrobial results, using a points threshold of ", points_threshold, - add_fn = font_black, - as_note = FALSE + add_fn = font_red ) } } @@ -505,34 +500,28 @@ first_isolate <- function(x = NULL, x$newvar_genus_species != "" & (x$other_pat_or_mo | x$more_than_episode_ago) } - + + decimal.mark <- getOption("OutDec") + big.mark <- ifelse(decimal.mark != ",", ",", " ") + # first one as TRUE x[row.start, "newvar_first_isolate"] <- TRUE # no tests that should be included, or ICU if (!is.null(col_testcode)) { x[which(x[, col_testcode] %in% tolower(testcodes_exclude)), "newvar_first_isolate"] <- FALSE } - - if (!is.null(col_icu)) { + if (any(!is.na(x$newvar_is_icu)) && any(x$newvar_is_icu == TRUE, na.rm = TRUE)) { if (icu_exclude == TRUE) { if (isTRUE(info)) { - message_("Excluding ", format(sum(col_icu, na.rm = TRUE), big.mark = " "), " isolates from ICU.", - add_fn = font_black, - as_note = FALSE - ) + message_("Excluding ", format(sum(x$newvar_is_icu, na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark), " isolates from ICU.", + add_fn = font_red) } - x[which(col_icu), "newvar_first_isolate"] <- FALSE + x[which(x$newvar_is_icu), "newvar_first_isolate"] <- FALSE } else if (isTRUE(info)) { - message_("Including isolates from ICU.", - add_fn = font_black, - as_note = FALSE - ) + message_("Including isolates from ICU.") } } - decimal.mark <- getOption("OutDec") - big.mark <- ifelse(decimal.mark != ",", ",", " ") - if (isTRUE(info)) { # print group name if used in dplyr::group_by() cur_group <- import_fn("cur_group", "dplyr", error_on_fail = FALSE) @@ -560,11 +549,12 @@ first_isolate <- function(x = NULL, # handle empty microorganisms if (any(x$newvar_mo == "UNKNOWN", na.rm = TRUE) && isTRUE(info)) { message_( - ifelse(include_unknown == TRUE, "Included ", "Excluded "), + ifelse(include_unknown == TRUE, "Including ", "Excluding "), format(sum(x$newvar_mo == "UNKNOWN", na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark ), - " isolates with a microbial ID 'UNKNOWN' (in column '", font_bold(col_mo), "')" + " isolates with a microbial ID 'UNKNOWN' (in column '", font_bold(col_mo), "')", + add_fn = font_red ) } x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown @@ -572,10 +562,11 @@ first_isolate <- function(x = NULL, # exclude all NAs if (anyNA(x$newvar_mo) && isTRUE(info)) { message_( - "Excluded ", format(sum(is.na(x$newvar_mo), na.rm = TRUE), + "Excluding ", format(sum(is.na(x$newvar_mo), na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark ), - " isolates with a microbial ID 'NA' (in column '", font_bold(col_mo), "')" + " isolates with a microbial ID `NA` (in column '", font_bold(col_mo), "')", + add_fn = font_red ) } x[which(is.na(x$newvar_mo)), "newvar_first_isolate"] <- FALSE