diff --git a/.gitlab-ci.R b/.gitlab-ci.R index aea195d1..0b6c2629 100644 --- a/.gitlab-ci.R +++ b/.gitlab-ci.R @@ -23,7 +23,11 @@ install_if_needed <- function(pkg, repos, quiet) { package_path <- find.package(pkg, quiet = quiet) if (length(package_path) == 0) { message("NOTE: pkg ", pkg, " missing, installing...") - install.packages(pkg, repos = repos, quiet = quiet) + if (pkg == "cleaner") { + devtools::install_github("msberends/cleaner") + } else { + install.packages(pkg, repos = repos, quiet = quiet) + } } } @@ -41,6 +45,7 @@ gl_update_pkg_all <- function(repos = "https://cran.rstudio.com", if (install_lintr == TRUE) { install_if_needed(pkg = "lintr", repos = repos, quiet = quiet) } + install_if_needed(pkg = "cleaner", repos = repos, quiet = quiet) devtools::install_dev_deps(repos = repos, quiet = quiet, upgrade = TRUE) diff --git a/DESCRIPTION b/DESCRIPTION index 055df164..7bce8c0d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.8.0.9007 -Date: 2019-10-30 +Version: 0.8.0.9008 +Date: 2019-11-03 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), @@ -36,7 +36,7 @@ Depends: R (>= 3.1.0) Imports: backports, - clean (>= 1.1.0), + cleaner, crayon (>= 1.3.0), data.table (>= 1.9.0), dplyr (>= 0.7.0), diff --git a/NAMESPACE b/NAMESPACE index ed00fbae..55f6f52e 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -232,9 +232,10 @@ exportMethods(skewness.matrix) exportMethods(summary.mic) exportMethods(summary.mo) exportMethods(summary.rsi) -importFrom(clean,freq) -importFrom(clean,freq.default) -importFrom(clean,top_freq) +importFrom(cleaner,freq) +importFrom(cleaner,freq.default) +importFrom(cleaner,percentage) +importFrom(cleaner,top_freq) importFrom(crayon,bgGreen) importFrom(crayon,bgRed) importFrom(crayon,bgYellow) diff --git a/NEWS.md b/NEWS.md index 21e2cd94..8153b720 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,10 @@ -# AMR 0.8.0.9007 -Last updated: 30-Oct-2019 +# AMR 0.8.0.9008 +Last updated: 03-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.** +* 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 ### 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 @@ -12,6 +14,10 @@ * Added "imi" as allowed abbreviation for Imipenem * Fix for automatically determining columns with antibiotic results in `mdro()` and `eucast_rules()` * Added ATC codes for ceftaroline, ceftobiprole and faropenem and fixed two typos in the `antibiotics` data set +* More robust way of determining valid MIC values + +### Other +* Change dependency on `clean` to `cleaner`, as this package was renamed accordingly upon CRAN request # AMR 0.8.0 diff --git a/R/availability.R b/R/availability.R index a05cb2d2..95fb0fcf 100644 --- a/R/availability.R +++ b/R/availability.R @@ -27,7 +27,7 @@ #' @details The function returns a \code{data.frame} with columns \code{"resistant"} and \code{"visual_resistance"}. The values in that columns are calculated with \code{\link{portion_R}}. #' @return \code{data.frame} with column names of \code{tbl} as row names #' @inheritSection AMR Read more on our website! -# @importFrom clean percentage +#' @importFrom cleaner percentage #' @export #' @examples #' availability(example_isolates) diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 3921b54c..bcdd3728 100644 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -33,7 +33,6 @@ #' @inheritParams base::formatC #' @importFrom dplyr %>% rename group_by select mutate filter summarise ungroup #' @importFrom tidyr spread -# @importFrom clean freq percentage #' @details The function \code{format} calculates the resistance per bug-drug combination. Use \code{combine_IR = FALSE} (default) to test R vs. S+I and \code{combine_IR = TRUE} to test R+I vs. S. #' #' The language of the output can be overwritten with \code{options(AMR_locale)}, please see \link{translate}. @@ -95,6 +94,7 @@ bug_drug_combinations <- function(x, #' @importFrom dplyr everything rename %>% ungroup group_by summarise mutate_all arrange everything lag #' @importFrom tidyr spread +#' @importFrom cleaner percentage #' @exportMethod format.bug_drug_combinations #' @export #' @rdname bug_drug_combinations diff --git a/R/catalogue_of_life.R b/R/catalogue_of_life.R index bd5d7f65..edb11c69 100755 --- a/R/catalogue_of_life.R +++ b/R/catalogue_of_life.R @@ -90,7 +90,6 @@ NULL #' @export #' @examples #' library(dplyr) -#' library(clean) #' microorganisms %>% freq(kingdom) #' microorganisms %>% group_by(kingdom) %>% freq(phylum, nmax = NULL) catalogue_of_life_version <- function() { diff --git a/R/freq.R b/R/freq.R index 120b9697..ebba431d 100755 --- a/R/freq.R +++ b/R/freq.R @@ -19,14 +19,13 @@ # Visit our website for more info: https://msberends.gitlab.io/AMR. # # ==================================================================== # -#' @importFrom clean freq +#' @importFrom cleaner freq #' @export -clean::freq +cleaner::freq #' @exportMethod freq.mo #' @importFrom dplyr n_distinct -#' @importFrom clean freq.default -# @importFrom clean percentage +#' @importFrom cleaner freq.default percentage #' @export #' @noRd freq.mo <- function(x, ...) { @@ -53,7 +52,7 @@ freq.mo <- function(x, ...) { } #' @exportMethod freq.rsi -#' @importFrom clean freq.default +#' @importFrom cleaner freq.default #' @export #' @noRd freq.rsi <- function(x, ...) { diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index 06b8a199..2a7a953e 100755 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -337,7 +337,7 @@ facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) { } #' @rdname ggplot_rsi -# @importFrom clean percentage +#' @importFrom cleaner percentage #' @export scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) { stopifnot_installed_package("ggplot2") @@ -387,7 +387,7 @@ theme_rsi <- function() { #' @rdname ggplot_rsi #' @importFrom dplyr mutate %>% group_by_at -# @importFrom clean percentage +#' @importFrom cleaner percentage #' @export labels_rsi_count <- function(position = NULL, x = "antibiotic", diff --git a/R/like.R b/R/like.R index eedfd210..6b388e12 100755 --- a/R/like.R +++ b/R/like.R @@ -48,7 +48,6 @@ #' #' # get frequencies of bacteria whose name start with 'Ent' or 'ent' #' library(dplyr) -#' library(clean) #' example_isolates %>% #' left_join_microorganisms() %>% #' filter(genus %like% '^ent') %>% diff --git a/R/mdro.R b/R/mdro.R index d9bef3e5..ec990963 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -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 diff --git a/R/mic.R b/R/mic.R index 4dbf0b60..25211016 100755 --- a/R/mic.R +++ b/R/mic.R @@ -51,8 +51,6 @@ #' #' plot(mic_data) #' barplot(mic_data) -#' -#' library(clean) #' freq(mic_data) as.mic <- function(x, na.rm = FALSE) { if (is.mic(x)) { @@ -97,98 +95,15 @@ as.mic <- function(x, na.rm = FALSE) { x[x.bak != "" & x == ""] <- "invalid" # these are allowed MIC values and will become factor levels - lvls <- c("<0.001", "<=0.001", "0.001", ">=0.001", ">0.001", - "<0.002", "<=0.002", "0.002", ">=0.002", ">0.002", - "<0.003", "<=0.003", "0.003", ">=0.003", ">0.003", - "<0.004", "<=0.004", "0.004", ">=0.004", ">0.004", - "<0.005", "<=0.005", "0.005", ">=0.005", ">0.005", - "<0.006", "<=0.006", "0.006", ">=0.006", ">0.006", - "<0.007", "<=0.007", "0.007", ">=0.007", ">0.007", - "<0.008", "<=0.008", "0.008", ">=0.008", ">0.008", - "<0.009", "<=0.009", "0.009", ">=0.009", ">0.009", - "<0.01", "<=0.01", "0.01", ">=0.01", ">0.01", - "<0.012", "<=0.012", "0.012", ">=0.012", ">0.012", - "<0.0125", "<=0.0125", "0.0125", ">=0.0125", ">0.0125", - "<0.016", "<=0.016", "0.016", ">=0.016", ">0.016", - "<0.019", "<=0.019", "0.019", ">=0.019", ">0.019", - "<0.02", "<=0.02", "0.02", ">=0.02", ">0.02", - "<0.023", "<=0.023", "0.023", ">=0.023", ">0.023", - "<0.025", "<=0.025", "0.025", ">=0.025", ">0.025", - "<0.028", "<=0.028", "0.028", ">=0.028", ">0.028", - "<0.03", "<=0.03", "0.03", ">=0.03", ">0.03", - "<0.031", "<=0.031", "0.031", ">=0.031", ">0.031", - "<0.032", "<=0.032", "0.032", ">=0.032", ">0.032", - "<0.038", "<=0.038", "0.038", ">=0.038", ">0.038", - "<0.04", "<=0.04", "0.04", ">=0.04", ">0.04", - "<0.047", "<=0.047", "0.047", ">=0.047", ">0.047", - "<0.05", "<=0.05", "0.05", ">=0.05", ">0.05", - "<0.054", "<=0.054", "0.054", ">=0.054", ">0.054", - "<0.06", "<=0.06", "0.06", ">=0.06", ">0.06", - "<0.0625", "<=0.0625", "0.0625", ">=0.0625", ">0.0625", - "<0.063", "<=0.063", "0.063", ">=0.063", ">0.063", - "<0.064", "<=0.064", "0.064", ">=0.064", ">0.064", - "<0.075", "<=0.075", "0.075", ">=0.075", ">0.075", - "<0.08", "<=0.08", "0.08", ">=0.08", ">0.08", - "<0.09", "<=0.09", "0.09", ">=0.09", ">0.09", - "<0.094", "<=0.094", "0.094", ">=0.094", ">0.094", - "<0.095", "<=0.095", "0.095", ">=0.095", ">0.095", - "<0.1", "<=0.1", "0.1", ">=0.1", ">0.1", - "<0.12", "<=0.12", "0.12", ">=0.12", ">0.12", - "<0.125", "<=0.125", "0.125", ">=0.125", ">0.125", - "<0.128", "<=0.128", "0.128", ">=0.128", ">0.128", - "<0.15", "<=0.15", "0.15", ">=0.15", ">0.15", - "<0.16", "<=0.16", "0.16", ">=0.16", ">0.16", - "<0.17", "<=0.17", "0.17", ">=0.17", ">0.17", - "<0.18", "<=0.18", "0.18", ">=0.18", ">0.18", - "<0.19", "<=0.19", "0.19", ">=0.19", ">0.19", - "<0.2", "<=0.2", "0.2", ">=0.2", ">0.2", - "<0.23", "<=0.23", "0.23", ">=0.23", ">0.23", - "<0.25", "<=0.25", "0.25", ">=0.25", ">0.25", - "<0.256", "<=0.256", "0.256", ">=0.256", ">0.256", - "<0.28", "<=0.28", "0.28", ">=0.28", ">0.28", - "<0.3", "<=0.3", "0.3", ">=0.3", ">0.3", - "<0.32", "<=0.32", "0.32", ">=0.32", ">0.32", - "<0.35", "<=0.35", "0.35", ">=0.35", ">0.35", - "<0.36", "<=0.36", "0.36", ">=0.36", ">0.36", - "<0.38", "<=0.38", "0.38", ">=0.38", ">0.38", - "<0.47", "<=0.47", "0.47", ">=0.47", ">0.47", - "<0.5", "<=0.5", "0.5", ">=0.5", ">0.5", - "<0.512", "<=0.512", "0.512", ">=0.512", ">0.512", - "<0.64", "<=0.64", "0.64", ">=0.64", ">0.64", - "<0.73", "<=0.73", "0.73", ">=0.73", ">0.73", - "<0.75", "<=0.75", "0.75", ">=0.75", ">0.75", - "<0.8", "<=0.8", "0.8", ">=0.8", ">0.8", - "<0.94", "<=0.94", "0.94", ">=0.94", ">0.94", - "<1", "<=1", "1", ">=1", ">1", - "<1.5", "<=1.5", "1.5", ">=1.5", ">1.5", - "<2", "<=2", "2", ">=2", ">2", - "<3", "<=3", "3", ">=3", ">3", - "<4", "<=4", "4", ">=4", ">4", - "<5", "<=5", "5", ">=5", ">5", - "<6", "<=6", "6", ">=6", ">6", - "<7", "<=7", "7", ">=7", ">7", - "<8", "<=8", "8", ">=8", ">8", - "<10", "<=10", "10", ">=10", ">10", - "<12", "<=12", "12", ">=12", ">12", - "<16", "<=16", "16", ">=16", ">16", - "<20", "<=20", "20", ">=20", ">20", - "<24", "<=24", "24", ">=24", ">24", - "<32", "<=32", "32", ">=32", ">32", - "<40", "<=40", "40", ">=40", ">40", - "<48", "<=48", "48", ">=48", ">48", - "<64", "<=64", "64", ">=64", ">64", - "<80", "<=80", "80", ">=80", ">80", - "<96", "<=96", "96", ">=96", ">96", - "<128", "<=128", "128", ">=128", ">128", - "129", - "<160", "<=160", "160", ">=160", ">160", - "<256", "<=256", "256", ">=256", ">256", - "257", - "<320", "<=320", "320", ">=320", ">320", - "<512", "<=512", "512", ">=512", ">512", - "513", - "<1024", "<=1024", "1024", ">=1024", ">1024", - "1025") + ops <- c("<", "<=", "", ">=", ">") + lvls <- c(c(t(sapply(ops, function(x) paste0(x, "0.00", 1:9)))), + unique(c(t(sapply(ops, function(x) paste0(x, sort(as.double(paste0("0.0", + sort(c(1:99, 125, 128, 256, 512, 625)))))))))), + unique(c(t(sapply(ops, function(x) paste0(x, sort(as.double(paste0("0.", + c(1:99, 125, 128, 256, 512))))))))), + c(t(sapply(ops, function(x) paste0(x, sort(c(1:9, 1.5)))))), + c(t(sapply(ops, function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])))), + c(t(sapply(ops, function(x) paste0(x, sort(c(2 ^ c(7:10), 80 * c(2:12)))))))) na_before <- x[is.na(x) | x == ""] %>% length() x[!x %in% lvls] <- NA diff --git a/R/misc.R b/R/misc.R index 4bd874c3..8a275ec8 100755 --- a/R/misc.R +++ b/R/misc.R @@ -127,45 +127,3 @@ class_integrity_check <- function(value, type, check_vector) { } value } - - - - -# Percentages ------------------------------------------------------------- -# Can all be removed when clean 1.2.0 is on CRAN - -getdecimalplaces <- function(x, minimum = 0, maximum = 3) { - if (maximum < minimum) { - maximum <- minimum - } - if (minimum > maximum) { - minimum <- maximum - } - max_places <- max(unlist(lapply(strsplit(sub("0+$", "", - as.character(x * 100)), ".", fixed = TRUE), - function(y) ifelse(length(y) == 2, nchar(y[2]), 0))), na.rm = TRUE) - max(min(max_places, - maximum, na.rm = TRUE), - minimum, na.rm = TRUE) -} - -round2 <- function(x, digits = 0, force_zero = TRUE) { - # https://stackoverflow.com/a/12688836/4575331 - val <- (trunc((abs(x) * 10 ^ digits) + 0.5) / 10 ^ digits) * sign(x) - if (digits > 0 & force_zero == TRUE) { - val[val != as.integer(val) & !is.na(val)] <- paste0(val[val != as.integer(val) & !is.na(val)], - strrep("0", max(0, digits - nchar(gsub(".*[.](.*)$", "\\1", val[val != as.integer(val) & !is.na(val)]))))) - } - val -} - -percentage <- function(x, digits = NULL, ...) { - if (is.null(digits)) { - digits <- getdecimalplaces(x, minimum = 0, maximum = 1) - } - # round right: percentage(0.4455) should return "44.6%", not "44.5%" - x <- as.numeric(round2(x, digits = digits + 2)) - x_formatted <- format(as.double(x) * 100, scientific = FALSE, digits = digits, nsmall = digits, ...) - x_formatted[!is.na(x)] <- paste0(x_formatted[!is.na(x)], "%") - x_formatted -} diff --git a/R/mo.R b/R/mo.R index d6eff413..5d64def4 100755 --- a/R/mo.R +++ b/R/mo.R @@ -267,7 +267,7 @@ is.mo <- function(x) { #' @importFrom dplyr %>% pull left_join n_distinct progress_estimated filter distinct #' @importFrom data.table data.table as.data.table setkey #' @importFrom crayon magenta red blue silver italic -# @importFrom clean percentage +#' @importFrom cleaner percentage # param property a column name of AMR::microorganisms # param initial_search logical - is FALSE when coming from uncertain tries, which uses exec_as.mo internally too # param dyslexia_mode logical - also check for characters that resemble others @@ -1774,7 +1774,7 @@ pillar_shaft.mo <- function(x, ...) { #' @exportMethod summary.mo #' @importFrom dplyr n_distinct -#' @importFrom clean freq top_freq +#' @importFrom cleaner freq top_freq #' @export #' @noRd summary.mo <- function(object, ...) { diff --git a/R/rsi.R b/R/rsi.R index 3748a3b6..89f3d95f 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -73,8 +73,6 @@ #' #' plot(rsi_data) # for percentages #' barplot(rsi_data) # for frequencies -#' -#' library(clean) #' freq(rsi_data) # frequency table with informative header #' #' # using dplyr's mutate diff --git a/R/rsi_calc.R b/R/rsi_calc.R index 6f631bc1..8f6c2df7 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -39,7 +39,7 @@ dots2vars <- function(...) { } #' @importFrom dplyr %>% pull all_vars any_vars filter_all funs mutate_all -# @importFrom clean percentage +#' @importFrom cleaner percentage rsi_calc <- function(..., ab_result, minimum = 0, diff --git a/data-raw/reproduction_of_antibiotics.R b/data-raw/reproduction_of_antibiotics.R index c7812506..75bd702a 100644 --- a/data-raw/reproduction_of_antibiotics.R +++ b/data-raw/reproduction_of_antibiotics.R @@ -308,7 +308,7 @@ antibiotics[which(antibiotics$ab == "CTX"), "abbreviations"][[1]] <- list(c(anti antibiotics[which(antibiotics$ab == "GEH"), "abbreviations"][[1]] <- list(c("gehl", "gentamicin high", "genta high")) antibiotics[which(antibiotics$ab == "STH"), "abbreviations"][[1]] <- list(c("sthl", "streptomycin high", "strepto high")) # add imi to imipenem -antibiotics[which(antibiotics$ab == "IPM"), "abbreviations"][[1]] <- list(c("imip", "imi")) +antibiotics[which(antibiotics$ab == "IPM"), "abbreviations"][[1]] <- list(c("imip", "imi", "imp")) ## new ATC codes # ceftaroline diff --git a/data/antibiotics.rda b/data/antibiotics.rda index d2fc0e81..5174e282 100755 Binary files a/data/antibiotics.rda and b/data/antibiotics.rda differ diff --git a/docs/404.html b/docs/404.html index a9c81c96..a23546f3 100644 --- a/docs/404.html +++ b/docs/404.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 235bfeb6..d9a871a9 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 diff --git a/docs/articles/index.html b/docs/articles/index.html index 1e29a142..463a45d8 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 diff --git a/docs/authors.html b/docs/authors.html index f90b0c5f..965cb58c 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 diff --git a/docs/index.html b/docs/index.html index 12572cdd..2c98ae4d 100644 --- a/docs/index.html +++ b/docs/index.html @@ -45,7 +45,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 diff --git a/docs/news/index.html b/docs/news/index.html index 98c6ec10..0b35e58b 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 @@ -231,16 +231,20 @@ -
+

-AMR 0.8.0.9007 Unreleased +AMR 0.8.0.9008 Unreleased

-

Last updated: 30-Oct-2019

+

Last updated: 03-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. +
  • 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
      • +
@@ -257,6 +261,14 @@
  • Fix for automatically determining columns with antibiotic results in mdro() and eucast_rules()
  • Added ATC codes for ceftaroline, ceftobiprole and faropenem and fixed two typos in the antibiotics data set
    • +
  • More robust way of determining valid MIC values
    • + +
    +
    +

    +Other

    +
    @@ -286,7 +298,7 @@ For WHONET users, this means that all records/isolates with organism code #> Warning message: #> invalid microorganism code, NA generated This is important, because a value like "testvalue" could never be understood by e.g. mo_name(), although the class would suggest a valid microbial code. -
  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).
    • +
  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

  • Renamed data set septic_patients to example_isolates

    • @@ -401,9 +413,9 @@ Since this is a major change, usage of the old also_single_tested w
  • Added more MIC factor levels (as.mic())
    • -
    +

    -Other

    +Other
    -
    +

    -Other

    +Other
    • Fixed a note thrown by CRAN tests
    @@ -543,7 +555,7 @@ Please age() function gained a new parameter exact to determine ages with decimals
  • Removed deprecated functions guess_mo(), guess_atc(), EUCAST_rules(), interpretive_reading(), rsi()
    • -
  • Frequency tables (freq()): +
  • Frequency tables (freq()):
    • @@ -567,7 +579,7 @@ Please age_groups(), to let groups of fives and tens end with 100+ instead of 120+ -
  • Fix for freq() for when all values are NA +
  • Fix for freq() for when all values are NA
  • Fix for first_isolate() for when dates are missing
  • Improved speed of guess_ab_col() @@ -580,9 +592,9 @@ Please mo_shortname() where species would not be determined correctly

    • -
    +

    -Other

    +Other -
  • Frequency tables (freq() function): +
  • Frequency tables (freq() function):
    • + freq(mo_genus(mo))
  • Header info is now available as a list, with the header function
  • The parameter header is now set to TRUE at default, even for markdown
    • @@ -828,9 +840,9 @@ Using as.mo(..., allow_uncertain = 3)if using different lengths of pattern and x in %like%, it will now return the call
    -
    +

    -Other

    +Other
    • Updated licence text to emphasise GPL 2.0 and that this is an R package.
    @@ -892,18 +904,18 @@ Using as.mo(..., allow_uncertain = 3)Using portion_* functions now throws a warning when total available isolate is below parameter minimum
  • Functions as.mo, as.rsi, as.mic, as.atc and freq will not set package name as attribute anymore
    • -
  • Frequency tables - freq(): +
  • Frequency tables - freq():

  • Support for (un)selecting columns:

    septic_patients %>% 
-  freq(hospital_id) %>% 
+  freq(hospital_id) %>% 
   select(-count, -cum_count) # only get item, percent, cum_percent
  • Check for hms::is.hms @@ -953,9 +965,9 @@ Using as.mo(..., allow_uncertain = 3)

    Percentages will now will rounded more logically (e.g. in freq function)

    • -
    +

    -Other

    +Other
    • New dependency on package crayon, to support formatted text in the console
    • Dependency tidyr is now mandatory (went to Import field) since portion_df and count_df rely on it
      • @@ -1082,17 +1094,17 @@ Using as.mo(..., allow_uncertain = 3)

      Support for types (classes) list and matrix for freq

      my_matrix = with(septic_patients, matrix(c(age, gender), ncol = 2))
-freq(my_matrix)
      +freq(my_matrix)

    For lists, subsetting is possible:

    my_list = list(age = septic_patients$age, gender = septic_patients$gender)
-my_list %>% freq(age)
-my_list %>% freq(gender)
    +my_list %>% freq(age) +my_list %>% freq(gender)
    -
    +

    -Other

    +Other
    • More unit tests to ensure better integrity of functions
    @@ -1160,13 +1172,13 @@ Using as.mo(..., allow_uncertain = 3)
  • A vignette to explain its usage
  • Support for rsi (antimicrobial resistance) to use as input
    • -
  • Support for table to use as input: freq(table(x, y)) +
  • Support for table to use as input: freq(table(x, y))
  • Support for existing functions hist and plot to use a frequency table as input: hist(freq(df$age))
  • Support for as.vector, as.data.frame, as_tibble and format
    • -
  • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn) +
  • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn)
  • Function top_freq function to return the top/below n items as vector
  • Header of frequency tables now also show Mean Absolute Deviaton (MAD) and Interquartile Range (IQR)
    • @@ -1219,9 +1231,9 @@ Using as.mo(..., allow_uncertain = 3)Other small fixes
    -
    +

    -Other

    +Other
    • Added integration tests (check if everything works as expected) for all releases of R 3.1 and higher
    -
    +

    -Other

    +Other
    • Expanded README.md with more examples
    • Added ORCID of authors to DESCRIPTION file
      • @@ -1320,7 +1332,7 @@ Using as.mo(..., allow_uncertain = 3)

      Contents

        -
      • 0.8.0.9007
        • +
      • 0.8.0.9008
      • 0.8.0
      • 0.7.1
      • 0.7.0
        • diff --git a/docs/reference/as.mic.html b/docs/reference/as.mic.html index fb0a1894..e43f1657 100644 --- a/docs/reference/as.mic.html +++ b/docs/reference/as.mic.html @@ -85,7 +85,7 @@ AMR (for R) - 0.8.0 + 0.8.0.9008
    @@ -288,9 +288,7 @@ plot(mic_data) barplot(mic_data) - -library(clean) -freq(mic_data) +freq(mic_data)
    @@ -336,9 +336,7 @@ plot(rsi_data) # for percentages barplot(rsi_data) # for frequencies - -library(clean) -freq(rsi_data) # frequency table with informative header +freq(rsi_data) # frequency table with informative header # using dplyr's mutate library(dplyr) diff --git a/docs/reference/catalogue_of_life_version.html b/docs/reference/catalogue_of_life_version.html index 7098082c..c9855855 100644 --- a/docs/reference/catalogue_of_life_version.html +++ b/docs/reference/catalogue_of_life_version.html @@ -85,7 +85,7 @@ AMR (for R) - 0.8.0 + 0.8.0.9008
    @@ -264,9 +264,8 @@ This package contains the complete taxonomic tree of almost all microorganisms (

    Examples

    library(dplyr)
-library(clean)
-microorganisms %>% freq(kingdom)
-microorganisms %>% group_by(kingdom) %>% freq(phylum, nmax = NULL)
    +microorganisms %>% freq(kingdom) +microorganisms %>% group_by(kingdom) %>% freq(phylum, nmax = NULL)
    diff --git a/docs/reference/index.html b/docs/reference/index.html index 5ec7a9eb..e23de94e 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -84,7 +84,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 diff --git a/docs/reference/like.html b/docs/reference/like.html index ff179794..99af62db 100644 --- a/docs/reference/like.html +++ b/docs/reference/like.html @@ -85,7 +85,7 @@ AMR (for R) - 0.8.0 + 0.8.0.9008 @@ -304,11 +304,10 @@ # get frequencies of bacteria whose name start with 'Ent' or 'ent' library(dplyr) -library(clean) example_isolates %>% left_join_microorganisms() %>% filter(genus %like% '^ent') %>% - freq(genus, species) + freq(genus, species) @@ -238,7 +238,7 @@ 
    mdro(x, guideline = NULL, col_mo = NULL, info = TRUE,
-  verbose = FALSE, ...)
+  verbose = FALSE, pct_required_classes = 0.5, ...)
 
 brmo(x, guideline = "BRMO", ...)
 
@@ -255,7 +255,7 @@
     
     
       x
-      
    table with antibiotic columns, like e.g. AMX and AMC
    
+      
    data with antibiotic columns, like e.g. AMX and AMC
    
     
     
       guideline
@@ -273,10 +273,18 @@
       verbose
       
    print additional info: missing antibiotic columns per parameter
    
     
+    
+      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 S. aureus. Setting this pct_required_classes argument to 0.5 (default) means that for every S. aureus isolate at least 8 different classes must be available. Any lower number of available classes will return NA for that isolate.
    
+    
     
       ...
       
    column name of an antibiotic, see section Antibiotics
    
     
+    
+      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.
    
+    
     
 
     
    Source
    
@@ -294,7 +302,8 @@
 
     
    Details
    
 
-    
    Currently supported guidelines are (case-insensitive):
      
+    
      For the pct_required_classes argument, values above 1 will be divided by 100. This is to support both fractions (0.75 or 3/4) and percentages (75).
+Currently supported guidelines are (case-insensitive):
        
 
      • guideline = "CMI2012": 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) (link)
        • 
 
      • guideline = "EUCAST": The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (link)
        • 
 
      • guideline = "TB": The international guideline for multi-drug resistant tuberculosis - World Health Organization "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis" (link)
        • 
@@ -399,18 +408,18 @@
 
 example_isolates %>%
   mdro() %>%
-  freq()
+  freq()
 
 # \donttest{
 example_isolates %>%
-  mutate(EUCAST = mdro(.),
+  mutate(EUCAST = eucast_exceptional_phenotypes(.),
          BRMO = brmo(.),
          MRGN = mrgn(.))
 
 example_isolates %>%
   rename(PIP = TZP) %>% # no piperacillin, so take piperacillin/tazobactam
   mrgn() %>%            # check German guideline
-  freq()                # check frequencies
+  freq()                # check frequencies
 # }
    diff --git a/docs/reference/mo_property.html b/docs/reference/mo_property.html index 97deaab8..055ae38b 100644 --- a/docs/reference/mo_property.html +++ b/docs/reference/mo_property.html @@ -85,7 +85,7 @@ AMR (for R) - 0.8.0.9007 + 0.8.0.9008 diff --git a/docs/reference/reexports.html b/docs/reference/reexports.html index 90791d69..985e135f 100644 --- a/docs/reference/reexports.html +++ b/docs/reference/reexports.html @@ -54,7 +54,7 @@ @@ -90,7 +90,7 @@ below to see their documentation. AMR (for R) - 0.8.0 + 0.8.0.9008 @@ -242,7 +242,7 @@ below to see their documentation.

    These objects are imported from other packages. Follow the links below to see their documentation.

    -
    clean

    freq

    +
    cleaner

    freq

    diff --git a/man/as.mic.Rd b/man/as.mic.Rd index b46617e9..25a09b47 100755 --- a/man/as.mic.Rd +++ b/man/as.mic.Rd @@ -47,8 +47,6 @@ as.rsi(x = as.mic(4), plot(mic_data) barplot(mic_data) - -library(clean) freq(mic_data) } \seealso{ diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index 6c1458ec..90faf7e4 100755 --- a/man/as.rsi.Rd +++ b/man/as.rsi.Rd @@ -90,8 +90,6 @@ as.rsi(x = as.mic(4), plot(rsi_data) # for percentages barplot(rsi_data) # for frequencies - -library(clean) freq(rsi_data) # frequency table with informative header # using dplyr's mutate diff --git a/man/catalogue_of_life_version.Rd b/man/catalogue_of_life_version.Rd index 26bffce6..a24d5806 100644 --- a/man/catalogue_of_life_version.Rd +++ b/man/catalogue_of_life_version.Rd @@ -30,7 +30,6 @@ On our website \url{https://msberends.gitlab.io/AMR} you can find \href{https:// \examples{ library(dplyr) -library(clean) microorganisms \%>\% freq(kingdom) microorganisms \%>\% group_by(kingdom) \%>\% freq(phylum, nmax = NULL) } diff --git a/man/like.Rd b/man/like.Rd index 4d4169ff..35e15b7e 100755 --- a/man/like.Rd +++ b/man/like.Rd @@ -62,7 +62,6 @@ a \%like\% b # get frequencies of bacteria whose name start with 'Ent' or 'ent' library(dplyr) -library(clean) example_isolates \%>\% left_join_microorganisms() \%>\% filter(genus \%like\% '^ent') \%>\% diff --git a/man/mdro.Rd b/man/mdro.Rd index 7c839bb8..63acaf1c 100644 --- a/man/mdro.Rd +++ b/man/mdro.Rd @@ -13,7 +13,7 @@ Please see Details for the list of publications used for this function. } \usage{ mdro(x, guideline = NULL, col_mo = NULL, info = TRUE, - verbose = FALSE, ...) + verbose = FALSE, pct_required_classes = 0.5, ...) brmo(x, guideline = "BRMO", ...) @@ -26,7 +26,7 @@ mdr_cmi2012(x, guideline = "CMI2012", ...) eucast_exceptional_phenotypes(x, guideline = "EUCAST", ...) } \arguments{ -\item{x}{table with antibiotic columns, like e.g. \code{AMX} and \code{AMC}} +\item{x}{data with antibiotic columns, like e.g. \code{AMX} and \code{AMC}} \item{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.} @@ -36,7 +36,11 @@ eucast_exceptional_phenotypes(x, guideline = "EUCAST", ...) \item{verbose}{print additional info: missing antibiotic columns per parameter} +\item{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.} + \item{...}{column name of an antibiotic, see section Antibiotics} + +\item{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.} } \value{ \itemize{ @@ -50,6 +54,7 @@ eucast_exceptional_phenotypes(x, guideline = "EUCAST", ...) Determine which isolates are multidrug-resistant organisms (MDRO) according to (country-specific) guidelines. } \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})} @@ -156,13 +161,13 @@ On our website \url{https://msberends.gitlab.io/AMR} you can find \href{https:// \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(.)) diff --git a/man/reexports.Rd b/man/reexports.Rd index 211ecdd9..4f14eecb 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -11,6 +11,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{clean}{\code{\link[clean]{freq}}} + \item{cleaner}{\code{\link[cleaner]{freq}}} }} diff --git a/tests/testthat/test-freq.R b/tests/testthat/test-freq.R index 5dd39359..db032e7b 100755 --- a/tests/testthat/test-freq.R +++ b/tests/testthat/test-freq.R @@ -22,7 +22,7 @@ context("freq.R") test_that("frequency table works", { - library(clean) + library(cleaner) # mo expect_true(is.freq(freq(example_isolates$mo))) # for this to work, the output of mo_gramstain() is to be expected as follows: diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R index a117f67d..268162a8 100755 --- a/tests/testthat/test-mdro.R +++ b/tests/testthat/test-mdro.R @@ -133,6 +133,7 @@ test_that("mdro works", { "S. aureus", "R", "R", "I", "I", "I", "I", "I", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R" ) expect_equal(as.integer(mdro(stau)), c(1:4)) + expect_s3_class(mdro(stau, verbose = TRUE), "data.frame") ente <- tribble( ~mo, ~GEH, ~STH, ~IPM, ~MEM, ~DOR, ~CIP, ~LVX, ~MFX, ~VAN, ~TEC, ~TGC, ~DAP, ~LNZ, ~AMP, ~QDA, ~DOX, ~MNO, @@ -142,6 +143,7 @@ test_that("mdro works", { "Enterococcus", "R", "R", "I", "I", "I", "I", "I", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R" ) expect_equal(as.integer(mdro(ente)), c(1:4)) + expect_s3_class(mdro(ente, verbose = TRUE), "data.frame") entero <- tribble( ~mo, ~GEN, ~TOB, ~AMK, ~NET, ~CPT, ~TCC, ~TZP, ~ETP, ~IPM, ~MEM, ~DOR, ~CZO, ~CXM, ~CTX, ~CAZ, ~FEP, ~FOX, ~CTT, ~CIP, ~SXT, ~TGC, ~ATM, ~AMP, ~AMC, ~SAM, ~CHL, ~FOS, ~COL, ~TCY, ~DOX, ~MNO, @@ -151,6 +153,7 @@ test_that("mdro works", { "E. coli", "R", "R", "I", "I", "I", "I", "I", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R" ) expect_equal(as.integer(mdro(entero)), c(1:4)) + expect_s3_class(mdro(entero, verbose = TRUE), "data.frame") pseud <- tribble( ~mo, ~GEN, ~TOB, ~AMK, ~NET, ~IPM, ~MEM, ~DOR, ~CAZ, ~FEP, ~CIP, ~LVX, ~TCC, ~TZP, ~ATM, ~FOS, ~COL, ~PLB, @@ -160,6 +163,7 @@ test_that("mdro works", { "P. aeruginosa", "R", "R", "I", "I", "I", "I", "I", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R" ) expect_equal(as.integer(mdro(pseud)), c(1:4)) + expect_s3_class(mdro(pseud, verbose = TRUE), "data.frame") acin <- tribble( ~mo, ~GEN, ~TOB, ~AMK, ~NET, ~IPM, ~MEM, ~DOR, ~CIP, ~LVX, ~TZP, ~TCC, ~CTX, ~CRO, ~CAZ, ~FEP, ~SXT, ~SAM, ~COL, ~PLB, ~TCY, ~DOX, ~MNO, @@ -169,5 +173,6 @@ test_that("mdro works", { "A. baumannii", "R", "R", "I", "I", "I", "I", "I", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R" ) expect_equal(as.integer(mdro(acin)), c(1:4)) + expect_s3_class(mdro(acin, verbose = TRUE), "data.frame") })