1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-12 09:01:52 +02:00

(v0.8.0.9008) new verbose mode for MDROs

This commit is contained in:
2019-11-03 22:24:42 +01:00
parent 09c4b04cd0
commit 29e448883d
42 changed files with 338 additions and 343 deletions

284
R/mdro.R
View File

@ -22,13 +22,16 @@
#' Determine multidrug-resistant organisms (MDRO)
#'
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to (country-specific) guidelines.
#' @param x table with antibiotic columns, like e.g. \code{AMX} and \code{AMC}
#' @param guideline a specific guideline to follow. When left empty, the publication by Magiorakos \emph{et al.} (2012, Clinical Microbiology and Infection) will be followed, see Details.
#' @param info print progress
#' @inheritParams eucast_rules
#' @param verbose print additional info: missing antibiotic columns per parameter
#' @param pct_required_classes minimal required percentage of antimicrobial classes that must be available per isolate, rounded down. For example, with the default guideline, 17 antimicrobial classes must be available for \emph{S. aureus}. Setting this \code{pct_required_classes} argument to \code{0.5} (default) means that for every \emph{S. aureus} isolate at least 8 different classes must be available. Any lower number of available classes will return \code{NA} for that isolate.
#' @param verbose a logical to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
#' @inheritSection eucast_rules Antibiotics
#' @details Currently supported guidelines are (case-insensitive):
#' @details
#' For the \code{pct_required_classes} argument, values above 1 will be divided by 100. This is to support both fractions (\code{0.75} or \code{3/4}) and percentages (\code{75}).
#' Currently supported guidelines are (case-insensitive):
#' \itemize{
#' \item{\code{guideline = "CMI2012"}: Magiorakos AP, Srinivasan A \emph{et al.} "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." Clinical Microbiology and Infection (2012) (\href{https://www.clinicalmicrobiologyandinfection.com/article/S1198-743X(14)61632-3/fulltext}{link})}
#' \item{\code{guideline = "EUCAST"}: The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\href{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}{link})}
@ -38,6 +41,7 @@
#' }
#'
#' Please suggest your own (country-specific) guidelines by letting us know: \url{https://gitlab.com/msberends/AMR/issues/new}.
#'
#' @return \itemize{
#' \item{CMI 2012 paper - function \code{mdr_cmi2012()} or \code{mdro()}:\cr Ordered factor with levels \code{Negative < Multi-drug-resistant (MDR) < Extensively drug-resistant (XDR) < Pandrug-resistant (PDR)}}
#' \item{TB guideline - function \code{mdr_tb()} or \code{mdro(..., guideline = "TB")}:\cr Ordered factor with levels \code{Negative < Mono-resistant < Poly-resistant < Multi-drug-resistant < Extensively drug-resistant}}
@ -47,6 +51,7 @@
#' @rdname mdro
#' @importFrom dplyr %>% filter_all
#' @importFrom crayon blue bold italic
#' @importFrom cleaner percentage
#' @export
#' @inheritSection AMR Read more on our website!
#' @source
@ -54,13 +59,13 @@
#' @examples
#' library(dplyr)
#'
#' example_isolates %>%
#' mdro() %>%
#' example_isolates %>%
#' mdro() %>%
#' freq()
#'
#' \donttest{
#' example_isolates %>%
#' mutate(EUCAST = mdro(.),
#' mutate(EUCAST = eucast_exceptional_phenotypes(.),
#' BRMO = brmo(.),
#' MRGN = mrgn(.))
#'
@ -74,13 +79,35 @@ mdro <- function(x,
col_mo = NULL,
info = TRUE,
verbose = FALSE,
pct_required_classes = 0.5,
...) {
if (verbose == TRUE & interactive()) {
txt <- paste0("WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.",
"\n\nThis may overwrite your existing data if you use e.g.:",
"\ndata <- mdro(data, verbose = TRUE)\n\nDo you want to continue?")
if ("rstudioapi" %in% rownames(utils::installed.packages())) {
q_continue <- rstudioapi::showQuestion("Using verbose = TRUE with mdro()", txt)
} else {
q_continue <- menu(choices = c("OK", "Cancel"), graphics = TRUE, title = txt)
}
if (q_continue %in% c(FALSE, 2)) {
message("Cancelled, returning original data")
return(x)
}
}
if (!is.data.frame(x)) {
stop("`x` must be a data frame.", call. = FALSE)
}
if (!is.numeric(pct_required_classes)) {
stop("`pct_required_classes` must be numeric.", call. = FALSE)
}
if (pct_required_classes > 1) {
# allow pct_required_classes = 75 -> pct_required_classes = 0.75
pct_required_classes <- pct_required_classes / 100
}
if (!is.null(list(...)$country)) {
warning("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call. = FALSE)
guideline <- list(...)$country
@ -88,7 +115,7 @@ mdro <- function(x,
if (length(guideline) > 1) {
stop("`guideline` must be a length one character string.", call. = FALSE)
}
if (is.null(guideline)) {
# default to the paper by Magiorakos et al. (2012)
guideline <- "cmi2012"
@ -103,7 +130,7 @@ mdro <- function(x,
stop("invalid guideline: ", guideline, call. = FALSE)
}
guideline <- list(code = tolower(guideline))
# try to find columns based on type
# -- mo
if (is.null(col_mo)) {
@ -118,7 +145,7 @@ mdro <- function(x,
if (is.null(col_mo)) {
stop("`col_mo` must be set.", call. = FALSE)
}
if (guideline$code == "cmi2012") {
guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
guideline$author <- "Magiorakos AP, Srinivasan A, Carey RB, ..., Vatopoulos A, Weber JT, Monnet DL"
@ -130,13 +157,13 @@ mdro <- function(x,
guideline$author <- "EUCAST (European Committee on Antimicrobial Susceptibility Testing)"
guideline$version <- "3.1"
guideline$source <- "http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf"
} else if (guideline$code == "tb") {
guideline$name <- "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis"
guideline$author <- "WHO (World Health Organization)"
guideline$version <- "WHO/HTM/TB/2014.11"
guideline$source <- "https://www.who.int/tb/publications/pmdt_companionhandbook/en/"
# support per country:
} else if (guideline$code == "mrgn") {
guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms"
@ -152,7 +179,7 @@ mdro <- function(x,
} else {
stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE)
}
if (guideline$code == "cmi2012") {
cols_ab <- get_column_abx(x = x,
soft_dependencies = c(
@ -270,7 +297,7 @@ mdro <- function(x,
"TCY",
"DOX",
"MNO"
),
),
verbose = verbose, ...)
} else if (guideline$code == "tb") {
cols_ab <- get_column_abx(x = x,
@ -295,7 +322,7 @@ mdro <- function(x,
} else {
cols_ab <- get_column_abx(x = x, verbose = verbose, ...)
}
AMC <- cols_ab["AMC"]
AMK <- cols_ab["AMK"]
AMP <- cols_ab["AMP"]
@ -391,21 +418,23 @@ mdro <- function(x,
bold("Source: "), guideline$source, "\n",
"\n", sep = "")
}
ab_missing <- function(ab) {
isTRUE(ab %in% c(NULL, NA)) | length(ab) == 0
}
ab_NA <- function(x) {
x[!is.na(x)]
}
verbose_df <- NULL
# antibiotic classes
aminoglycosides <- c(TOB, GEN)
cephalosporins <- c(FEP, CTX, FOX, CED, CAZ, CRO, CXM, CZO)
cephalosporins_3rd <- c(CTX, CRO, CAZ)
carbapenems <- c(ETP, IPM, MEM)
fluoroquinolones <- c(OFX, CIP, LVX, MFX)
# helper function for editing the table
trans_tbl <- function(to, rows, cols, any_all) {
cols <- cols[!ab_missing(cols)]
@ -421,41 +450,41 @@ mdro <- function(x,
}
rows <- rows[rows %in% row_filter]
x[rows, "MDRO"] <<- to
x[rows, "reason"] <<- paste0(any_all, " of these ", ifelse(any_all == "any", "is", "are"), " R: ",
paste(cols, collapse = ", "))
}
}
trans_tbl2 <- function(txt, rows, lst) {
if (info == TRUE) {
message(blue(txt, "..."), appendLF = FALSE)
}
# function specific for the CMI paper of 2012 (Magiorakos et al.)
lst_vector <- unlist(lst)[!is.na(unlist(lst))]
x$total_groups <- NA_integer_
x$affected_groups <- NA_integer_
x[rows, "total_groups"] <- length(lst)
# now the hard part - using two sapply()s for super fast results:
# [1] run through all `rows` with sapply()
# [2] within each row, run through all antibiotic groups with another sapply()
# [3] determine for each antibiotic group in that row if at least 1 drug is R of I
# [4] sum the number of TRUEs of this determination
x[rows, "affected_groups"] <- sapply(rows,
function(row, group_tbl = lst) {
sum(sapply(group_tbl,
function(group) {
any(x[row, group[!is.na(group)]] == "R") |
any(x[row, group[!is.na(group)]] == "I")
}),
na.rm = TRUE)
})
# now set MDROs:
# MDR (=2): >=3 groups affected
x[which(x$row_number %in% rows & x$affected_groups >= 3), "MDRO"] <<- 2
# XDR (=3): all but <=2 groups affected
x[which(x$row_number %in% rows & (x$total_groups - x$affected_groups) <= 2), "MDRO"] <<- 3
# PDR (=4): all agents are R
x[filter_at(x[rows, ],
vars(lst_vector),
all_vars(. %in% c("R", "I")))$row_number,
"MDRO"] <<- 4
if (length(rows) > 0) {
# function specific for the CMI paper of 2012 (Magiorakos et al.)
lst_vector <- unlist(lst)[!is.na(unlist(lst))]
x[rows, "classes_in_guideline"] <<- length(lst)
x[rows, "classes_available"] <<- sapply(rows,
function(row, group_tbl = lst) {
sum(sapply(group_tbl, function(group) !all(is.na(group))))
})
# now the hard part - using two sapply()s for super fast results:
# [1] run through all `rows` with sapply()
# [2] within each row, run through all antibiotic classes with another sapply()
# [3] determine for each antibiotic group in that row if at least 1 drug is R of I
# [4] sum the number of TRUEs of this determination
x[rows, "classes_affected"] <<- sapply(rows,
function(row, group_tbl = lst) {
sum(sapply(group_tbl,
function(group) {
any(x[row, group[!is.na(group)]] == "R") |
any(x[row, group[!is.na(group)]] == "I")
}),
na.rm = TRUE)
})
x[filter_at(x[rows,],
vars(lst_vector),
all_vars(. %in% c("R", "I")))$row_number, "classes_affected"] <<- 999
}
if (info == TRUE) {
message(blue(" OK"))
}
@ -465,9 +494,10 @@ mdro <- function(x,
mutate_at(vars(col_mo), as.mo) %>%
# join to microorganisms data set
left_join_microorganisms(by = col_mo) %>%
# add unconfirmed to where genus is available
# add unavailable to where genus is available
mutate(MDRO = ifelse(!is.na(genus), 1, NA_integer_),
row_number = seq_len(nrow(.))) %>%
row_number = seq_len(nrow(.)),
reason = paste0("not covered by ", toupper(guideline$code), " guideline")) %>%
# transform to data.frame so subsetting is possible with x[y, z] (might not be the case with tibble/data.table/...)
as.data.frame(stringsAsFactors = FALSE)
@ -475,19 +505,34 @@ mdro <- function(x,
# CMI, 2012 ---------------------------------------------------------------
# Non-susceptible = R and I
# (see header 'Approaches to Creating Definitions for MDR, XDR and PDR' in paper)
# take amoxicillin if ampicillin is unavailable
if (is.na(AMP) & !is.na(AMX)) AMP <- AMX
if (is.na(AMP) & !is.na(AMX)) {
if (verbose == TRUE) {
message(blue("NOTE: Filling ampicillin (AMP) results with amoxicillin (AMX) results"))
}
AMP <- AMX
}
# take ceftriaxone if cefotaxime is unavailable and vice versa
if (is.na(CRO) & !is.na(CTX)) CRO <- CTX
if (is.na(CTX) & !is.na(CRO)) CTX <- CRO
if (is.na(CRO) & !is.na(CTX)) {
if (verbose == TRUE) {
message(blue("NOTE: Filling ceftriaxone (CRO) results with cefotaxime (CTX) results"))
}
CRO <- CTX
}
if (is.na(CTX) & !is.na(CRO)) {
if (verbose == TRUE) {
message(blue("NOTE: Filling cefotaxime (CTX) results with ceftriaxone (CRO) results"))
}
CTX <- CRO
}
# intrinsic resistant must not be considered for the determination of MDR,
# so let's just remove them, meticulously following the paper
x[which(x$genus == "Enterococcus" & x$species == "faecium"), ab_NA(IPM)] <- NA
x[which(x$genus == "Enterococcus" & x$species == "faecalis"), ab_NA(QDA)] <- NA
x[which((x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(GEN, TOB, NET))] <- NA
| (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(GEN, TOB, NET))] <- NA
x[which(x$genus == "Escherichia" & x$species == "hermannii"), ab_NA(c(TCC, TZP))] <- NA
x[which((x$genus == "Citrobacter" & x$species == "freundii")
| (x$genus == "Enterobacter" & x$species == "aerogenes")
@ -554,6 +599,10 @@ mdro <- function(x,
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA
x$classes_in_guideline <- NA_integer_
x$classes_available <- NA_integer_
x$classes_affected <- NA_integer_
# now add the MDR levels to the data
trans_tbl(2,
which(x$genus == "Staphylococcus" & x$species == "aureus"),
@ -592,7 +641,7 @@ mdro <- function(x,
QDA,
c(DOX, MNO)))
trans_tbl2(paste0("Table 3 - ", italic("Enterobacteriaceae"),
" (before the taxonomic reclassification by Adeolu ", italic("et al."), ", 2016)"),
" (before the taxonomic reclassification by Adeolu ", italic("et al."), ", 2016)"),
# this new order was previously 'Enterobacteriales' and contained only the family 'Enterobacteriaceae':
which(x$order == "Enterobacterales"),
list(c(GEN, TOB, AMK, NET),
@ -634,6 +683,37 @@ mdro <- function(x,
SAM,
c(COL, PLB),
c(TCY, DOX, MNO)))
# now set MDROs:
# 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)],
" out of ", x$classes_available[which(x$classes_affected >= 3)], " available classes")
}
# XDR (=3): all but <=2 classes affected
x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3
if (verbose == TRUE) {
x[which((x$classes_in_guideline - x$classes_affected) <= 2), "reason"] <- paste0("less than 3 classes remain susceptible (", x$classes_in_guideline[which((x$classes_in_guideline - x$classes_affected) <= 2)] - x$classes_affected[which((x$classes_in_guideline - x$classes_affected) <= 2)],
" out of ", x$classes_in_guideline[which((x$classes_in_guideline - x$classes_affected) <= 2)], " classes)")
}
# PDR (=4): all agents are R
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
if (verbose == TRUE) {
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "reason"] <- paste("all antibiotics in all", x$classes_in_guideline[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available)], "classes were tested R or I")
}
# not enough classes available
x[which(x$classes_available < base::floor(x$classes_in_guideline * pct_required_classes)), "MDRO"] <- -1
if (verbose == TRUE) {
x[which(x$classes_available < base::floor(x$classes_in_guideline * pct_required_classes)), "reason"] <- paste0("not enough classes available: ", x$classes_available[which(x$classes_available < base::floor(x$classes_in_guideline * pct_required_classes))],
" instead of ", (base::floor(x$classes_in_guideline * pct_required_classes))[which(x$classes_available < base::floor(x$classes_in_guideline * pct_required_classes))],
" (~", percentage(pct_required_classes), " of ", x$classes_in_guideline[which(x$classes_available < base::floor(x$classes_in_guideline * pct_required_classes))], ")")
}
# some more info on negative results
if (verbose == TRUE) {
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))], " of ", x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))], " available classes contain R or I (3 required for MDR)")
}
}
if (guideline$code == "eucast") {
@ -693,14 +773,14 @@ mdro <- function(x,
# Table 7
trans_tbl(3,
which(x$genus == "Bacteroides"),
MTR,
MTR,
"any")
trans_tbl(3,
which(x$fullname %like% "^Clostridium difficile"),
c(MTR, VAN),
"any")
}
if (guideline$code == "mrgn") {
# Germany -----------------------------------------------------------------
CTX_or_CAZ <- CTX %or% CAZ
@ -715,7 +795,7 @@ mdro <- function(x,
# Table 1
x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
x$fullname %like% "^Acinetobacter baumannii") &
x$fullname %like% "^Acinetobacter baumannii") &
x[, PIP] == "R" &
x[, CTX_or_CAZ] == "R" &
x[, IPM_or_MEM] == "S" &
@ -749,7 +829,7 @@ mdro <- function(x,
x[, CIP] == "R"),
"MDRO"] <- 3 # 3 = 4MRGN
}
if (guideline$code == "brmo") {
# Netherlands -------------------------------------------------------------
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
@ -762,23 +842,23 @@ mdro <- function(x,
if (length(ESBLs) != 2) {
ESBLs <- character(0)
}
# Table 1
trans_tbl(3,
which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
c(aminoglycosides, fluoroquinolones),
"all")
trans_tbl(2,
which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
carbapenems,
"any")
trans_tbl(2,
which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
ESBLs,
"all")
# Table 2
trans_tbl(2,
which(x$genus == "Acinetobacter"),
@ -788,12 +868,12 @@ mdro <- function(x,
which(x$genus == "Acinetobacter"),
c(aminoglycosides, fluoroquinolones),
"all")
trans_tbl(3,
which(x$fullname %like% "^Stenotrophomonas maltophilia"),
SXT,
"all")
if (!ab_missing(MEM) & !ab_missing(IPM)
& !ab_missing(GEN) & !ab_missing(TOB)
& !ab_missing(CIP)
@ -812,7 +892,7 @@ mdro <- function(x,
x$fullname %like% "Pseudomonas aeruginosa"
& x$psae >= 3
), "MDRO"] <- 3
# Table 3
trans_tbl(3,
which(x$fullname %like% "Streptococcus pneumoniae"),
@ -827,7 +907,7 @@ mdro <- function(x,
c(PEN, VAN),
"all")
}
prepare_drug <- function(ab) {
# returns vector values of drug
# if `ab` is a column name, looks up the values in `x`
@ -858,7 +938,7 @@ mdro <- function(x,
ab != "R"
}
}
if (guideline$code == "tb") {
# Tuberculosis ------------------------------------------------------------
x <- x %>%
@ -881,43 +961,59 @@ mdro <- function(x,
TRUE, FALSE),
xdr = ifelse(mdr & xdr & second, TRUE, FALSE)) %>%
mutate(MDRO = case_when(xdr ~ 5,
mdr ~ 4,
poly ~ 3,
mono ~ 2,
TRUE ~ 1),
mdr ~ 4,
poly ~ 3,
mono ~ 2,
TRUE ~ 1),
# keep all real TB, make other species NA
MDRO = ifelse(x$fullname == "Mycobacterium tuberculosis", MDRO, NA_real_))
}
if (info == TRUE) {
cat(bold(paste0("=> Found ", sum(x$MDRO %in% c(2:5), na.rm = TRUE), " MDROs out of ", sum(!is.na(x$MDRO)),
" possible cases (", percentage(sum(x$MDRO %in% c(2:5), na.rm = TRUE) / sum(!is.na(x$MDRO))), ")")))
" tested isolates (", percentage(sum(x$MDRO %in% c(2:5), na.rm = TRUE) / sum(!is.na(x$MDRO))), ")\n")))
}
# return results
# Results ----
if (guideline$code == "cmi2012") {
factor(x = x$MDRO,
levels = 1:4,
labels = c("Negative", "Multi-drug-resistant (MDR)",
"Extensively drug-resistant (XDR)", "Pandrug-resistant (PDR)"),
ordered = TRUE)
if (any(x$MDRO == -1)) {
warning("NA introduced for isolates where the available percentage of antimicrobial classes was below ",
percentage(pct_required_classes), " (set with `pct_required_classes`)")
# set these -1s to NA
x[which(x$MDRO == -1), "MDRO"] <- NA_integer_
}
x$MDRO <- factor(x = x$MDRO,
levels = 1:4,
labels = c("Negative", "Multi-drug-resistant (MDR)",
"Extensively drug-resistant (XDR)", "Pandrug-resistant (PDR)"),
ordered = TRUE)
} else if (guideline$code == "tb") {
factor(x = x$MDRO,
levels = 1:5,
labels = c("Negative", "Mono-resistant", "Poly-resistant",
"Multi-drug-resistant", "Extensively drug-resistant"),
ordered = TRUE)
x$MDRO <- factor(x = x$MDRO,
levels = 1:5,
labels = c("Negative", "Mono-resistant", "Poly-resistant",
"Multi-drug-resistant", "Extensively drug-resistant"),
ordered = TRUE)
} else if (guideline$code == "mrgn") {
factor(x = x$MDRO,
levels = 1:3,
labels = c("Negative", "3MRGN", "4MRGN"),
ordered = TRUE)
x$MDRO <- factor(x = x$MDRO,
levels = 1:3,
labels = c("Negative", "3MRGN", "4MRGN"),
ordered = TRUE)
} else {
factor(x = x$MDRO,
levels = 1:3,
labels = c("Negative", "Positive, unconfirmed", "Positive"),
ordered = TRUE)
x$MDRO <- factor(x = x$MDRO,
levels = 1:3,
labels = c("Negative", "Positive, unconfirmed", "Positive"),
ordered = TRUE)
}
if (verbose == TRUE) {
x[, c("row_number",
col_mo,
"MDRO",
"reason")]
} else {
x$MDRO
}
}
#' @rdname mdro