diff --git a/DESCRIPTION b/DESCRIPTION index b206e671..f6536dea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.8.0.9011 -Date: 2019-11-04 +Version: 0.8.0.9012 +Date: 2019-11-05 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 13f9a7a2..cdd31124 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,10 +1,10 @@ -# AMR 0.8.0.9011 -Last updated: 04-Nov-2019 +# AMR 0.8.0.9012 +Last updated: 05-Nov-2019 ### New * Support for a new MDRO guideline: Magiorakos AP, Srinivasan A *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). * This is now the new default guideline for the `mdro()` function - * The new Verbose mode (`mdro(...., verbose = TRUE)`) returns an informative data set where the reason for MDRO determination is given for every isolate + * The new Verbose mode (`mdro(...., verbose = TRUE)`) returns an informative data set where the reason for MDRO determination is given for every isolate, and an list of the resistant antimicrobial agents ### Changes * When running `as.rsi()` over a data set, it will now print the guideline that will be used if it is not specified by the user diff --git a/R/mdro.R b/R/mdro.R index 15a19dad..4152e25d 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -48,7 +48,7 @@ #' \item{Everything else:\cr Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}. The value \code{"Positive, unconfirmed"} means that, according to the guideline, it is not entirely sure if the isolate is multi-drug resistant and this should be confirmed with additional (e.g. molecular) tests} #' } #' @rdname mdro -#' @importFrom dplyr %>% filter_at vars all_vars pull +#' @importFrom dplyr %>% filter_at vars all_vars pull mutate_at #' @importFrom crayon blue bold italic #' @importFrom cleaner percentage #' @export @@ -439,6 +439,15 @@ mdro <- function(x, cols <- cols[!ab_missing(cols)] cols <- cols[!is.na(cols)] if (length(rows) > 0 & length(cols) > 0) { + #print(cols) + x <<- x %>% mutate_at(vars(cols), as.rsi) + x[rows, "columns_nonsusceptible"] <<- sapply(rows, + function(row, group_vct = cols) { + cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y == "R") + paste(sort(c(unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ")), + names(cols_nonsus)[cols_nonsus])), + collapse = ", ") + }) if (any_all == "any") { row_filter <- which(x[, cols] == "R") } else if (any_all == "all") { @@ -449,8 +458,7 @@ 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 = ", ")) + x[rows, "reason"] <<- paste0(any_all, " of the required antibiotics ", ifelse(any_all == "any", "is", "are"), " R") } } trans_tbl2 <- function(txt, rows, lst) { @@ -460,16 +468,20 @@ mdro <- function(x, if (length(rows) > 0) { # function specific for the CMI paper of 2012 (Magiorakos et al.) lst_vector <- unlist(lst)[!is.na(unlist(lst))] + x <<- x %>% mutate_at(vars(lst_vector), as.rsi) 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 + function(row, group_tbl = lst) { + sum(sapply(group_tbl, function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% c("S", "I", "R")))) + }) + + if (verbose == TRUE) { + x[rows, "columns_nonsusceptible"] <<- sapply(rows, + function(row, group_vct = lst_vector) { + cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% c("I", "R")) + paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ") + }) + } x[rows, "classes_affected"] <<- sapply(rows, function(row, group_tbl = lst) { sum(sapply(group_tbl, @@ -479,7 +491,7 @@ mdro <- function(x, }), na.rm = TRUE) }) - x[filter_at(x[rows,], + x[filter_at(x[rows, ], vars(lst_vector), all_vars(. %in% c("R", "I")))$row_number, "classes_affected"] <<- 999 } @@ -496,7 +508,8 @@ mdro <- function(x, # add unavailable to where genus is available mutate(MDRO = ifelse(!is.na(genus), 1, NA_integer_), row_number = seq_len(nrow(.)), - reason = paste0("not covered by ", toupper(guideline$code), " guideline")) %>% + reason = paste0("not covered by ", toupper(guideline$code), " guideline"), + columns_nonsusceptible = "") %>% # 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) @@ -690,29 +703,30 @@ mdro <- function(x, 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)") + x[which(x$MDRO == 3), "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$MDRO == 3)], + " out of ", x$classes_in_guideline[which(x$MDRO == 3)], " 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") + x[which(x$MDRO == 4), "reason"] <- paste("all antibiotics in all", x$classes_in_guideline[which(x$MDRO == 4)], "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 + x[which(x$MDRO %in% c(1, 3) & 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)") + x[which(x$MDRO == -1), "reason"] <- paste0("not enough classes available: ", x$classes_available[which(x$MDRO == -1)], + " of required ", (base::floor(x$classes_in_guideline * pct_required_classes))[which(x$MDRO == -1)], + " (~", percentage(pct_required_classes), " of ", x$classes_in_guideline[which(x$MDRO == -1)], ")") } + + # add antibiotic names of resistant ones to verbose output + } if (guideline$code == "eucast") { @@ -973,6 +987,15 @@ mdro <- function(x, " tested isolates (", percentage(sum(x$MDRO %in% c(2:5), na.rm = TRUE) / sum(!is.na(x$MDRO))), ")\n"))) } + # some more info on negative results + if (verbose == TRUE ) { + if (guideline$code == "cmi2012") { + 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)") + } else { + x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R" + } + } + # Results ---- if (guideline$code == "cmi2012") { if (any(x$MDRO == -1, na.rm = TRUE)) { @@ -1008,7 +1031,9 @@ mdro <- function(x, x[, c("row_number", col_mo, "MDRO", - "reason")] + "reason", + "columns_nonsusceptible")] + #x } else { x$MDRO } diff --git a/R/rsi.R b/R/rsi.R index 89f3d95f..a076a45d 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -99,6 +99,12 @@ as.rsi.default <- function(x, ...) { x } else if (identical(levels(x), c("S", "I", "R"))) { structure(x, class = c("rsi", "ordered", "factor")) + } else if (identical(class(x), "integer") & all(x %in% c(1:3, NA))) { + x[x == 1] <- "S" + x[x == 2] <- "I" + x[x == 3] <- "R" + structure(.Data = factor(x, levels = c("S", "I", "R"), ordered = TRUE), + class = c("rsi", "ordered", "factor")) } else { x <- x %>% unlist() diff --git a/docs/404.html b/docs/404.html index 77be84b8..c5c2a079 100644 --- a/docs/404.html +++ b/docs/404.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9011 + 0.8.0.9012 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 2f50662f..f77d9227 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9011 + 0.8.0.9012 diff --git a/docs/articles/index.html b/docs/articles/index.html index ddeedb7d..88e2722a 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9011 + 0.8.0.9012 diff --git a/docs/authors.html b/docs/authors.html index 7932e0b8..6a4c1f28 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9011 + 0.8.0.9012 diff --git a/docs/index.html b/docs/index.html index 13df3ecc..ace2a680 100644 --- a/docs/index.html +++ b/docs/index.html @@ -45,7 +45,7 @@ AMR (for R) - 0.8.0.9011 + 0.8.0.9012 diff --git a/docs/news/index.html b/docs/news/index.html index 0c24888d..a480f852 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9011 + 0.8.0.9012 @@ -231,11 +231,11 @@ -
+

-AMR 0.8.0.9011 Unreleased +AMR 0.8.0.9012 Unreleased

-

Last updated: 04-Nov-2019

+

Last updated: 05-Nov-2019

New

@@ -1333,7 +1333,7 @@ Using as.mo(..., allow_uncertain = 3)

Contents

    -
  • 0.8.0.9011
    • +
  • 0.8.0.9012
  • 0.8.0
  • 0.7.1
  • 0.7.0
    • diff --git a/docs/reference/index.html b/docs/reference/index.html index 27263589..e8887faf 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9011 + 0.8.0.9012
diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R index 268162a8..3bdce791 100755 --- a/tests/testthat/test-mdro.R +++ b/tests/testthat/test-mdro.R @@ -32,7 +32,7 @@ test_that("mdro works", { expect_error(mdro(example_isolates, guideline = c("BRMO", "MRGN"), info = TRUE)) expect_error(mdro(example_isolates, col_mo = "invalid", info = TRUE)) - outcome <- mdro(example_isolates) + outcome <- suppressWarnings(mdro(example_isolates)) outcome <- eucast_exceptional_phenotypes(example_isolates, info = TRUE) # check class expect_equal(outcome %>% class(), c("ordered", "factor"))