diff --git a/DESCRIPTION b/DESCRIPTION
index a9e21a3d..4c7042a5 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: AMR
-Version: 1.5.0.9002
-Date: 2021-01-14
+Version: 1.5.0.9003
+Date: 2021-01-15
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(role = c("aut", "cre"),
diff --git a/NEWS.md b/NEWS.md
index a62f9358..20ca2958 100755
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,5 @@
-# AMR 1.5.0.9002
-## Last updated: 14 January 2021
+# AMR 1.5.0.9003
+## Last updated: 15 January 2021
### New
* Support for EUCAST Clinical Breakpoints v11.0 (2021), effective in the `eucast_rules()` function and in `as.rsi()` to interpret MIC and disk diffusion values. This is now the default guideline in this package.
@@ -31,6 +31,7 @@
* Updated the data set `microorganisms.codes` (which contains popular LIS and WHONET codes for microorganisms) for some species of *Mycobacterium* that previously incorrectly returned *M. africanum*
* Added Pretomanid (PMD, J04AK08) to the `antibiotics` data set
* WHONET code `"PNV"` will now correctly be interpreted as `PHN`, the antibiotic code for phenoxymethylpenicillin ('peni V')
+* Fix for verbose output of `mdro(..., verbose = TRUE)` for German guideline (3MGRN and 4MGRN) and *P. aeruginosa* in Dutch guideline (BRMO)
# AMR 1.5.0
diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R
index 667cdf17..feb35408 100644
--- a/R/bug_drug_combinations.R
+++ b/R/bug_drug_combinations.R
@@ -69,8 +69,10 @@ bug_drug_combinations <- function(x,
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo")
+ stop_if(is.null(col_mo), "`col_mo` must be set")
+ } else {
+ stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
}
- stop_if(is.null(col_mo), "`col_mo` must be set")
x_class <- class(x)
x <- as.data.frame(x, stringsAsFactors = FALSE)
diff --git a/R/eucast_rules.R b/R/eucast_rules.R
index d5c84317..a7495d56 100755
--- a/R/eucast_rules.R
+++ b/R/eucast_rules.R
@@ -205,8 +205,10 @@ eucast_rules <- function(x,
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo", info = info)
+ stop_if(is.null(col_mo), "`col_mo` must be set")
+ } else {
+ stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
}
- stop_if(is.null(col_mo), "`col_mo` must be set")
decimal.mark <- getOption("OutDec")
big.mark <- ifelse(decimal.mark != ",", ",", ".")
diff --git a/R/first_isolate.R b/R/first_isolate.R
index ee47afbd..0f294ad9 100755
--- a/R/first_isolate.R
+++ b/R/first_isolate.R
@@ -202,7 +202,6 @@ first_isolate <- function(x,
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo")
stop_if(is.null(col_mo), "`col_mo` must be set")
- stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
}
# -- date
diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R
index 2eead452..36819f18 100755
--- a/R/guess_ab_col.R
+++ b/R/guess_ab_col.R
@@ -122,7 +122,7 @@ get_column_abx <- function(x,
meet_criteria(info, allow_class = "logical", has_length = 1)
if (info == TRUE) {
- message_("Auto-guessing columns suitable for analysis", appendLF = FALSE)
+ message_("Auto-guessing columns suitable for analysis", appendLF = FALSE, as_note = FALSE)
}
x <- as.data.frame(x, stringsAsFactors = FALSE)
diff --git a/R/key_antibiotics.R b/R/key_antibiotics.R
index 37cc1667..354543f3 100755
--- a/R/key_antibiotics.R
+++ b/R/key_antibiotics.R
@@ -168,8 +168,10 @@ key_antibiotics <- function(x,
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo")
+ stop_if(is.null(col_mo), "`col_mo` must be set")
+ } else {
+ stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
}
- stop_if(is.null(col_mo), "`col_mo` must be set")
# check columns
col.list <- c(universal_1, universal_2, universal_3, universal_4, universal_5, universal_6,
diff --git a/R/mdro.R b/R/mdro.R
index 69f83681..9387c887 100755
--- a/R/mdro.R
+++ b/R/mdro.R
@@ -138,9 +138,6 @@ mdro <- function(x,
}
}
- stop_ifnot(is.data.frame(x), "`x` must be a data.frame")
- stop_if(any(dim(x) == 0), "`x` must contain rows and columns")
-
# force regular data.frame, not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
@@ -154,8 +151,8 @@ mdro <- function(x,
warning_("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call = FALSE)
guideline <- list(...)$country
}
-
- guideline.bak <- guideline
+
+ guideline.bak <- guideline
guideline <- tolower(gsub("[^a-zA-Z0-9.]+", "", guideline))
if (is.null(guideline)) {
# default to the paper by Magiorakos et al. (2012)
@@ -182,9 +179,9 @@ mdro <- function(x,
}
if (is.null(col_mo) & guideline$code == "tb") {
message_("No column found as input for `col_mo`, ",
- font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis.")))
- x$mo <- as.mo("Mycobacterium tuberculosis")
- col_mo <- "mo"
+ font_bold(paste0("assuming all records contain", font_italic("Mycobacterium tuberculosis"), ".")))
+ x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: MO_lookup[which(MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE]
+ col_mo <- "mo"
}
stop_if(is.null(col_mo), "`col_mo` must be set")
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
@@ -873,7 +870,9 @@ mdro <- function(x,
# MDR (=2): >=3 classes affected
x[which(x$classes_affected >= 3), "MDRO"] <- 2
if (verbose == TRUE) {
- x[which(x$classes_affected >= 3), "reason"] <- paste0("at least 3 classes contain R or I: ", x$classes_affected[which(x$classes_affected >= 3)],
+ x[which(x$classes_affected >= 3), "reason"] <- paste0("at least 3 classes contain R",
+ ifelse(!isTRUE(combine_SI), " or I", ""), ": ",
+ x$classes_affected[which(x$classes_affected >= 3)],
" out of ", x$classes_available[which(x$classes_affected >= 3)], " available classes")
}
@@ -1044,49 +1043,55 @@ mdro <- function(x,
# Germany -----------------------------------------------------------------
CTX_or_CAZ <- CTX %or% CAZ
IPM_or_MEM <- IPM %or% MEM
- x$missing <- NA_character_
- if (is.na(PIP)) PIP <- "missing"
- if (is.na(CTX_or_CAZ)) CTX_or_CAZ <- "missing"
- if (is.na(IPM_or_MEM)) IPM_or_MEM <- "missing"
- if (is.na(IPM)) IPM <- "missing"
- if (is.na(MEM)) MEM <- "missing"
- if (is.na(CIP)) CIP <- "missing"
# Table 1
- x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
- (x$genus == "Acinetobacter" & x$species == "baumannii")) &
- x[, PIP] == "R" &
- x[, CTX_or_CAZ] == "R" &
- x[, IPM_or_MEM] == "S" &
- x[, CIP] == "R"),
- "MDRO"] <- 2 # 2 = 3MRGN
+ trans_tbl(2, # 3MRGN
+ which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
+ (x$genus == "Acinetobacter" & x$species == "baumannii")) &
+ x[, PIP, drop = TRUE] == "R" &
+ x[, CTX_or_CAZ, drop = TRUE] == "R" &
+ x[, IPM_or_MEM, drop = TRUE] == "S" &
+ x[, CIP, drop = TRUE] == "R"),
+ c(PIP, CTX, CAZ, IPM, MEM, CIP),
+ "any")
- x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
- (x$genus == "Acinetobacter" & x$species == "baumannii")) &
- x[, PIP] == "R" &
- x[, CTX_or_CAZ] == "R" &
- x[, IPM_or_MEM] == "R" &
- x[, CIP] == "R"),
- "MDRO"] <- 3 # 3 = 4MRGN, overwrites 3MRGN if applicable
+ trans_tbl(3, # 4MRGN, overwrites 3MRGN if applicable
+ which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
+ (x$genus == "Acinetobacter" & x$species == "baumannii")) &
+ x[, PIP, drop = TRUE] == "R" &
+ x[, CTX_or_CAZ, drop = TRUE] == "R" &
+ x[, IPM_or_MEM, drop = TRUE] == "R" &
+ x[, CIP, drop = TRUE] == "R"),
+ c(PIP, CTX, CAZ, IPM, MEM, CIP),
+ "any")
- x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
- (x$genus == "Acinetobacter" & x$species == "baumannii")) &
- x[, IPM] == "R" | x[, MEM] == "R"),
- "MDRO"] <- 3 # 3 = 4MRGN, always when imipenem or meropenem is R
+ trans_tbl(3, # 4MRGN, overwrites 3MRGN if applicable
+ which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
+ (x$genus == "Acinetobacter" & x$species == "baumannii")) &
+ (x[, IPM, drop = TRUE] == "R" | x[, MEM, drop = TRUE] == "R")),
+ c(IPM, MEM),
+ "any")
- x[which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
- (x[, PIP] == "S") +
- (x[, CTX_or_CAZ] == "S") +
- (x[, IPM_or_MEM] == "S") +
- (x[, CIP] == "S") == 1),
- "MDRO"] <- 2 # 2 = 3MRGN, if only 1 group is S
+ trans_tbl(2, # 3MRGN, if only 1 group is S
+ which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
+ (x[, PIP, drop = TRUE] == "S") +
+ (x[, CTX_or_CAZ, drop = TRUE] == "S") +
+ (x[, IPM_or_MEM, drop = TRUE] == "S") +
+ (x[, CIP, drop = TRUE] == "S") == 1),
+ c(PIP, CTX, CAZ, IPM, MEM, CIP),
+ "any")
- x[which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
- x[, PIP] == "R" &
- x[, CTX_or_CAZ] == "R" &
- x[, IPM_or_MEM] == "R" &
- x[, CIP] == "R"),
- "MDRO"] <- 3 # 3 = 4MRGN
+ trans_tbl(3, # 4MRGN otherwise
+ which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
+ (x[, PIP, drop = TRUE] == "R" | x[, TZP, drop = TRUE] == "R") &
+ x[, CTX_or_CAZ, drop = TRUE] == "R" &
+ x[, IPM_or_MEM, drop = TRUE] == "R" &
+ x[, CIP, drop = TRUE] == "R"),
+ c(PIP, CTX, CAZ, IPM, MEM, CIP),
+ "any")
+
+ x[which(x$MDRO == 2), "reason"] <- "3MRGN"
+ x[which(x$MDRO == 3), "reason"] <- "4MRGN"
}
if (guideline$code == "brmo") {
@@ -1139,17 +1144,21 @@ mdro <- function(x,
& !ab_missing(CAZ)
& !ab_missing(TZP)) {
x$psae <- 0
- x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"] <- 1 + x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"]
- x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"] <- 1 + x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"]
- x[which(x[, CIP] == "R"), "psae"] <- 1 + x[which(x[, CIP] == "R"), "psae"]
- x[which(x[, CAZ] == "R"), "psae"] <- 1 + x[which(x[, CAZ] == "R"), "psae"]
- x[which(x[, TZP] == "R"), "psae"] <- 1 + x[which(x[, TZP] == "R"), "psae"]
+ x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"]
+ x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"]
+ x[which(x[, CIP, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, CIP, drop = TRUE] == "R"), "psae"]
+ x[which(x[, CAZ, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, CAZ, drop = TRUE] == "R"), "psae"]
+ x[which(x[, TZP, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, TZP, drop = TRUE] == "R"), "psae"]
} else {
x$psae <- 0
}
+ trans_tbl(3,
+ which(x$genus == "Pseudomonas" & x$species == "aeruginosa" & x$psae >= 3),
+ c(CAZ, CIP, GEN, IPM, MEM, TOB, TZP),
+ "any")
x[which(
x$genus == "Pseudomonas" & x$species == "aeruginosa"
- & x$psae >= 3), "MDRO"] <- 3
+ & x$psae >= 3), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", ""))
# Table 3
trans_tbl(3,
@@ -1224,6 +1233,7 @@ mdro <- function(x,
1))))
# keep all real TB, make other species NA
x$MDRO <- ifelse(x$fullname == "Mycobacterium tuberculosis", x$MDRO, NA_real_)
+ x$reason <- "PDR/MDR/XDR criteria were met"
}
if (info == TRUE) {
@@ -1248,7 +1258,7 @@ mdro <- function(x,
if (guideline$code == "cmi2012") {
if (any(x$MDRO == -1, na.rm = TRUE)) {
warning_("NA introduced for isolates where the available percentage of antimicrobial classes was below ",
- percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE)
+ percentage(pct_required_classes), " (set with `pct_required_classes`)", call = FALSE)
# set these -1s to NA
x[which(x$MDRO == -1), "MDRO"] <- NA_integer_
}
@@ -1280,8 +1290,8 @@ mdro <- function(x,
col_mo,
"MDRO",
"reason",
- "columns_nonsusceptible")]
- #x
+ "columns_nonsusceptible"),
+ drop = FALSE]
} else {
x$MDRO
}
diff --git a/data-raw/AMR_1.5.0.9002.tar.gz b/data-raw/AMR_1.5.0.9003.tar.gz
similarity index 78%
rename from data-raw/AMR_1.5.0.9002.tar.gz
rename to data-raw/AMR_1.5.0.9003.tar.gz
index a5777a9f..fc61f440 100644
Binary files a/data-raw/AMR_1.5.0.9002.tar.gz and b/data-raw/AMR_1.5.0.9003.tar.gz differ
diff --git a/docs/404.html b/docs/404.html
index d1e983a0..797effbb 100644
--- a/docs/404.html
+++ b/docs/404.html
@@ -81,7 +81,7 @@
NEWS.md
-
antibiotics
data set"PNV"
will now correctly be interpreted as PHN
, the antibiotic code for phenoxymethylpenicillin (‘peni V’)mdro(..., verbose = TRUE)
for German guideline (3MGRN and 4MGRN) and P. aeruginosa in Dutch guideline (BRMO)