diff --git a/DESCRIPTION b/DESCRIPTION index 263800627..59479626d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.1.1.9273 -Date: 2025-05-05 +Version: 2.1.1.9274 +Date: 2025-05-12 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 853d56fb6..fc62d2e51 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 2.1.1.9273 +# AMR 2.1.1.9274 *(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://amr-for-r.org/#get-this-package).)* diff --git a/R/ab.R b/R/ab.R index 3eff91bd6..36cec5613 100755 --- a/R/ab.R +++ b/R/ab.R @@ -652,7 +652,7 @@ generalise_antibiotic_name <- function(x) { # replace more than 1 space x <- trimws(gsub(" +", " ", x, perl = TRUE)) # remove last couple of words if they numbers or units - x <- gsub(" ([0-9]{3,99}|U?M?C?G)+$", "", x) + x <- gsub("( ([0-9]{3,}|U?M?C?G|L))+$", "", x, perl = TRUE) # move HIGH to end x <- trimws(gsub("(.*) HIGH(.*)", "\\1\\2 HIGH", x, perl = TRUE)) x diff --git a/R/mdro.R b/R/mdro.R index da1da65bb..02ad893ec 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -354,7 +354,7 @@ mdro <- function(x = NULL, "row_number", "MDRO", "reason", - "columns_nonsusceptible" + "all_nonsusceptible_columns" )]) } else { return(x$MDRO) @@ -762,7 +762,7 @@ mdro <- function(x = NULL, ), stringsAsFactors = FALSE ) - x[rows, "columns_nonsusceptible"] <<- vapply( + x[rows, "all_nonsusceptible_columns"] <<- vapply( FUN.VALUE = character(1), rows, function(row, group_vct = cols_ab) { @@ -773,7 +773,7 @@ mdro <- function(x = NULL, ) paste( sort(c( - unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)), + unlist(strsplit(x[row, "all_nonsusceptible_columns", drop = TRUE], ", ", fixed = TRUE)), names(cols_nonsus)[cols_nonsus] )), collapse = ", " @@ -844,7 +844,7 @@ mdro <- function(x = NULL, ) if (isTRUE(verbose)) { - x[rows, "columns_nonsusceptible"] <<- vapply( + x[rows, "all_nonsusceptible_columns"] <<- vapply( FUN.VALUE = character(1), rows, function(row, group_vct = lst_vector) { @@ -891,7 +891,7 @@ mdro <- function(x = NULL, x$MDRO <- ifelse(!is.na(x$genus), 1, NA_integer_) x$row_number <- seq_len(nrow(x)) x$reason <- NA_character_ - x$columns_nonsusceptible <- "" + x$all_nonsusceptible_columns <- "" if (guideline$code == "cmi2012") { # CMI, 2012 --------------------------------------------------------------- @@ -1948,7 +1948,7 @@ mdro <- function(x = NULL, "microorganism", "MDRO", "reason", - "columns_nonsusceptible" + "all_nonsusceptible_columns" ), drop = FALSE ] @@ -2115,19 +2115,19 @@ run_custom_mdro_guideline <- function(df, guideline, info) { out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE) } - columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R")) - columns_nonsusceptible <- vapply( + all_nonsusceptible_columns <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R")) + all_nonsusceptible_columns <- vapply( FUN.VALUE = character(1), - columns_nonsusceptible, - function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " ") + all_nonsusceptible_columns, + function(x) paste0(rownames(all_nonsusceptible_columns)[which(x)], collapse = " ") ) - columns_nonsusceptible[is.na(out)] <- NA_character_ + all_nonsusceptible_columns[is.na(out)] <- NA_character_ data.frame( row_number = seq_len(NROW(df)), MDRO = out, reason = reasons, - columns_nonsusceptible = columns_nonsusceptible, + all_nonsusceptible_columns = all_nonsusceptible_columns, stringsAsFactors = FALSE ) } diff --git a/R/sir.R b/R/sir.R index 365bc3dfa..14b0ae07d 100755 --- a/R/sir.R +++ b/R/sir.R @@ -161,7 +161,7 @@ #' #' The base R function [as.double()] can be used to retrieve quantitative values from a `sir` object: `"S"` = 1, `"I"`/`"SDD"` = 2, `"R"` = 3. All other values are rendered `NA` . **Note:** Do not use `as.integer()`, since that (because of how R works internally) will return the factor level indices, and not these aforementioned quantitative values. #' -#' The function [is_sir_eligible()] returns `TRUE` when a column contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R and/or NI and/or SDD), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector. +#' The function [is_sir_eligible()] returns `TRUE` when a column contains at most 5% potentially invalid antimicrobial interpretations, and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector. #' @section Interpretation of SIR: #' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (). #' @@ -387,7 +387,7 @@ as_sir_structure <- function(x, method = NULL, ref_tbl = NULL, ref_breakpoints = NULL) { - out <- structure( + structure( factor(as.character(unlist(unname(x))), levels = c("S", "SDD", "I", "R", "NI"), ordered = TRUE @@ -445,9 +445,9 @@ is_sir_eligible <- function(x, threshold = 0.05) { %in% class(x))) { # no transformation needed return(FALSE) - } else if (all(x %in% c("S", "SDD", "I", "R", "NI", NA)) & !all(is.na(x))) { + } else if (!all(is.na(x)) && all(toupper(x) %in% c("S", "SDD", "I", "R", "NI", NA))) { return(TRUE) - } else if (!any(c("S", "SDD", "I", "R", "NI") %in% x, na.rm = TRUE) & !all(is.na(x))) { + } else if (!all(is.na(x)) && !any(c("S", "SDD", "I", "R", "NI") %in% gsub("([SIR])\\1+", "\\1", gsub("[^A-Z]", "", toupper(x), perl = TRUE), perl = TRUE), na.rm = TRUE)) { return(FALSE) } else { x <- x[!is.na(x) & !is.null(x) & !x %in% c("", "-", "NULL")] diff --git a/man/as.sir.Rd b/man/as.sir.Rd index 6f952f4c5..3e2d91725 100644 --- a/man/as.sir.Rd +++ b/man/as.sir.Rd @@ -249,7 +249,7 @@ The function \code{\link[=is.sir]{is.sir()}} detects if the input contains class The base R function \code{\link[=as.double]{as.double()}} can be used to retrieve quantitative values from a \code{sir} object: \code{"S"} = 1, \code{"I"}/\code{"SDD"} = 2, \code{"R"} = 3. All other values are rendered \code{NA} . \strong{Note:} Do not use \code{as.integer()}, since that (because of how R works internally) will return the factor level indices, and not these aforementioned quantitative values. -The function \code{\link[=is_sir_eligible]{is_sir_eligible()}} returns \code{TRUE} when a column contains at most 5\% invalid antimicrobial interpretations (not S and/or I and/or R and/or NI and/or SDD), and \code{FALSE} otherwise. The threshold of 5\% can be set with the \code{threshold} argument. If the input is a \link{data.frame}, it iterates over all columns and returns a \link{logical} vector. +The function \code{\link[=is_sir_eligible]{is_sir_eligible()}} returns \code{TRUE} when a column contains at most 5\% potentially invalid antimicrobial interpretations, and \code{FALSE} otherwise. The threshold of 5\% can be set with the \code{threshold} argument. If the input is a \link{data.frame}, it iterates over all columns and returns a \link{logical} vector. } \code{NA_sir_} is a missing value of the new \code{sir} class, analogous to e.g. base \R's \code{\link[base:NA]{NA_character_}}. diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R index 71aa9cb44..4ac851564 100755 --- a/tests/testthat/test-mdro.R +++ b/tests/testthat/test-mdro.R @@ -282,6 +282,11 @@ test_that("test-mdro.R", { # info = FALSE # )) + expect_equal( + colnames(suppressWarnings(mdro(example_isolates[1:10, ], verbose = TRUE, info = FALSE))), + c("row_number", "microorganism", "MDRO", "reason", "all_nonsusceptible_columns") + ) + # print groups if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) { expect_output(x <- mdro(example_isolates %>% group_by(ward), info = TRUE, pct_required_classes = 0))