From 4fcc2b409a82e545edc5bf382d6f0a543805ec4b Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Fri, 16 Nov 2018 20:50:50 +0100 Subject: [PATCH] MDRO update --- DESCRIPTION | 4 +- NAMESPACE | 9 +- NEWS.md | 10 +- R/{eucast.R => eucast_rules.R} | 22 +- R/mdro.R | 253 +++++++++--------- R/read.4d.R | 13 +- man/{EUCAST.Rd => eucast_rules.Rd} | 15 +- man/{MDRO.Rd => mdro.Rd} | 24 +- .../{test-eucast.R => test-eucast_rules.R} | 21 +- tests/testthat/test-mdro.R | 22 +- 10 files changed, 207 insertions(+), 186 deletions(-) rename R/{eucast.R => eucast_rules.R} (99%) rename man/{EUCAST.Rd => eucast_rules.Rd} (96%) mode change 100755 => 100644 rename man/{MDRO.Rd => mdro.Rd} (95%) mode change 100755 => 100644 rename tests/testthat/{test-eucast.R => test-eucast_rules.R} (80%) diff --git a/DESCRIPTION b/DESCRIPTION index f7fea146..28121a7a 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.4.0.9010 -Date: 2018-11-09 +Version: 0.4.0.9011 +Date: 2018-11-16 Title: Antimicrobial Resistance Analysis Authors@R: c( person( diff --git a/NAMESPACE b/NAMESPACE index cbb34207..89ac6b88 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,11 +35,7 @@ S3method(skewness,matrix) S3method(summary,mic) S3method(summary,rsi) export("%like%") -export(BRMO) -export(EUCAST_exceptional_phenotypes) export(EUCAST_rules) -export(MDRO) -export(MRGN) export(ab_atc) export(ab_certe) export(ab_name) @@ -58,6 +54,7 @@ export(as.rsi) export(atc_ddd) export(atc_groups) export(atc_property) +export(brmo) export(count_I) export(count_IR) export(count_R) @@ -65,6 +62,8 @@ export(count_S) export(count_SI) export(count_all) export(count_df) +export(eucast_exceptional_phenotypes) +export(eucast_rules) export(facet_rsi) export(first_isolate) export(freq) @@ -91,6 +90,7 @@ export(kurtosis) export(labels_rsi_count) export(left_join_microorganisms) export(like) +export(mdro) export(mo_TSN) export(mo_authors) export(mo_class) @@ -110,6 +110,7 @@ export(mo_subspecies) export(mo_taxonomy) export(mo_type) export(mo_year) +export(mrgn) export(n_rsi) export(p.symbol) export(portion_I) diff --git a/NEWS.md b/NEWS.md index c45d4e3f..eae56280 100755 --- a/NEWS.md +++ b/NEWS.md @@ -9,14 +9,16 @@ * Functions `mo_authors` and `mo_year` to get specific values about the scientific reference of a taxonomic entry #### Changed -* Big changes to the `EUCAST_rules` function: +* Functions `MDRO`, `BRMO`, `MRGN` and `EUCAST_exceptional_phenotypes` were renamed to `mdro`, `brmo`, `mrgn` and `eucast_exceptional_phenotypes` +* `EUCAST_rules` was renamed to `eucast_rules`, the old function still exists as a deprecated function +* Big changes to the `eucast_rules` function: * Now also applies rules from the EUCAST 'Breakpoint tables for bacteria', version 8.1, 2018, http://www.eucast.org/clinical_breakpoints/ (see Source of the function) * New parameter `rules` to specify which rules should be applied (expert rules, breakpoints, others or all) * New parameter `verbose` which can be set to `TRUE` to get very specific messages about which columns and rows were affected * Better error handling when rules cannot be applied (i.e. new values could not be inserted) * The number of affected values will now only be measured once per row/column combination * Data set `septic_patients` now reflects these changes - * Added parameter `pipe` for piperacillin (J01CA12), also to the `MDRO` function + * Added parameter `pipe` for piperacillin (J01CA12), also to the `mdro` function * Small fixes to EUCAST clinical breakpoint rules * Added column `kingdom` to the microorganisms data set, and function `mo_kingdom` to look up values * Tremendous speed improvement for `as.mo` (and subsequently all `mo_*` functions), as empty values wil be ignored *a priori* @@ -41,11 +43,11 @@ * New parameter `header` to turn it off (default when `markdown = TRUE`) * New parameter `title` to replace the automatically set title * `first_isolate` now tries to find columns to use as input when parameters are left blank -* Improvement for MDRO algorithm +* Improvement for MDRO algorithm (function `mdro`) * Data set `septic_patients` is now a `data.frame`, not a tibble anymore * Removed diacritics from all authors (columns `microorganisms$ref` and `microorganisms.old$ref`) to comply with CRAN policy to only allow ASCII characters * Fix for `mo_property` not working properly -* Fix for `EUCAST_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5 +* Fix for `eucast_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5 * Support for named vectors of class `mo`, useful for `top_freq()` * `ggplot_rsi` and `scale_y_percent` have `breaks` parameter * AI improvements for `as.mo`: diff --git a/R/eucast.R b/R/eucast_rules.R similarity index 99% rename from R/eucast.R rename to R/eucast_rules.R index faa51a42..b7695b3b 100755 --- a/R/eucast.R +++ b/R/eucast_rules.R @@ -25,7 +25,7 @@ #' @param verbose a logical to indicate whether extensive info should be returned as a \code{data.frame} with info about which rows and columns are effected #' @param amcl,amik,amox,ampi,azit,azlo,aztr,cefa,cfep,cfot,cfox,cfra,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,mezl,mino,moxi,nali,neom,neti,nitr,norf,novo,oflo,oxac,peni,pipe,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column name of an antibiotic, see Details #' @param col_bactid deprecated, use \code{col_mo} instead. -#' @param ... parameters that are passed on to \code{EUCAST_rules} +#' @param ... parameters that are passed on to \code{eucast_rules} #' @inheritParams first_isolate #' @details To define antibiotics column names, input a text or use \code{NA} to skip a column (e.g. \code{tica = NA}). Non-existing columns will anyway be skipped with a warning. See the Antibiotics section for an explanation of the abbreviations. #' @section Antibiotics: @@ -94,7 +94,7 @@ #' \strong{trsu}: sulfamethoxazole and trimethoprim (\emph{J01EE01}), #' \strong{vanc}: vancomycin (\emph{J01XA01}). #' @keywords interpretive eucast reading resistance -#' @rdname EUCAST +#' @rdname eucast_rules #' @export #' @importFrom dplyr %>% select pull mutate_at vars #' @importFrom crayon bold bgGreen bgYellow bgRed black green blue italic strip_style @@ -116,7 +116,7 @@ #' } #' } #' @examples -#' a <- EUCAST_rules(septic_patients) +#' a <- eucast_rules(septic_patients) #' #' a <- data.frame(mo = c("Staphylococcus aureus", #' "Enterococcus faecalis", @@ -140,7 +140,7 @@ #' # 4 Klebsiella pneumoniae - - - - - S S #' # 5 Pseudomonas aeruginosa - - - - - S S #' -#' b <- EUCAST_rules(a, "mo") # 18 results are forced as R or S +#' b <- eucast_rules(a, "mo") # 18 results are forced as R or S #' #' b #' # mo vanc amox coli cfta cfur peni cfox @@ -149,7 +149,7 @@ #' # 3 Escherichia coli R - - - - R S #' # 4 Klebsiella pneumoniae R R - - - R S #' # 5 Pseudomonas aeruginosa R R - - R R R -EUCAST_rules <- function(tbl, +eucast_rules <- function(tbl, col_mo = NULL, info = TRUE, rules = c("breakpoints", "expert", "other", "all"), @@ -1745,8 +1745,16 @@ EUCAST_rules <- function(tbl, tbl_original } -#' @rdname EUCAST +#' @rdname eucast_rules +#' @export +EUCAST_rules <- function(...) { + .Deprecated("eucast_rules") + eucast_rules(...) +} + +#' @rdname eucast_rules #' @export interpretive_reading <- function(...) { - EUCAST_rules(...) + .Deprecated("eucast_rules") + eucast_rules(...) } diff --git a/R/mdro.R b/R/mdro.R index 1f109b90..5aa3b598 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -22,13 +22,13 @@ #' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl} #' @param country country code to determine guidelines. EUCAST rules will be used when left empty, see Details. Should be or a code from the \href{https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2#Officially_assigned_code_elements}{list of ISO 3166-1 alpha-2 country codes}. Case-insensitive. Currently supported are \code{de} (Germany) and \code{nl} (the Netherlands). #' @param info print progress -#' @inheritParams EUCAST_rules +#' @inheritParams eucast_rules #' @param metr column name of an antibiotic. Use \code{NA} to skip a column, like \code{tica = NA}. Non-existing columns will anyway be skipped. See the Antibiotics section for an explanation of the abbreviations. #' @param ... parameters that are passed on to methods -#' @inheritSection EUCAST_rules Antibiotics +#' @inheritSection eucast_rules Antibiotics #' @details When \code{country} will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}). -#' @return Ordered factor with levels \code{Unknown < Negative < Unconfirmed < Positive}. -#' @rdname MDRO +#' @return Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}. +#' @rdname mdro #' @importFrom dplyr %>% #' @importFrom crayon red blue #' @export @@ -36,9 +36,9 @@ #' library(dplyr) #' #' septic_patients %>% -#' mutate(EUCAST = MDRO(.), -#' BRMO = BRMO(.)) -MDRO <- function(tbl, +#' mutate(EUCAST = mdro(.), +#' BRMO = brmo(.)) +mdro <- function(tbl, country = NULL, col_mo = NULL, info = TRUE, @@ -129,8 +129,8 @@ MDRO <- function(tbl, country <- 'EUCAST' } country <- trimws(country) - if (country != 'EUCAST' & !country %like% '^[a-z]{2}$') { - stop('This is not a valid ISO 3166-1 alpha-2 country code: "', country, '". Please see ?MDRO.', call. = FALSE) + if (tolower(country) != 'eucast' & !country %like% '^[a-z]{2}$') { + stop('This is not a valid ISO 3166-1 alpha-2 country code: "', country, '". Please see ?mdro.', call. = FALSE) } # create list and make country code case-independent @@ -152,9 +152,9 @@ MDRO <- function(tbl, guideline$name <- 'WIP-Richtlijn BRMO' guideline$version <- 'Revision of December 2017' guideline$source <- 'https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH' - # add here more countries like this: - # } else if (country$code == 'xx') { - # country$name <- 'country name' + # add here more countries like this: + # } else if (country$code == 'xx') { + # country$name <- 'country name' } else { stop('This country code is currently unsupported: ', guideline$country$code, call. = FALSE) } @@ -243,10 +243,17 @@ MDRO <- function(tbl, fluoroquinolones <- c(oflo, cipr, levo, moxi) # helper function for editing the table - trans_tbl <- function(to, rows, cols) { + trans_tbl <- function(to, rows, cols, any_all) { cols <- cols[!is.na(cols)] if (length(rows) > 0 & length(cols) > 0) { - col_filter <- which(tbl[, cols] == 'R') + if (any_all == "any") { + col_filter <- which(tbl[, cols] == 'R') + } else if (any_all == "all") { + col_filter <- tbl %>% + mutate(index = 1:nrow(.)) %>% + filter_at(vars(cols), all_vars(. == "R")) %>% + pull((index)) + } rows <- rows[rows %in% col_filter] tbl[rows, 'MDRO'] <<- to } @@ -265,52 +272,66 @@ MDRO <- function(tbl, if (guideline$country$code == 'eucast') { # EUCAST ------------------------------------------------------------------ # Table 5 - trans_tbl(4, + trans_tbl(3, which(tbl$family == 'Enterobacteriaceae' | tbl$fullname %like% '^Pseudomonas aeruginosa' | tbl$genus == 'Acinetobacter'), - coli) - trans_tbl(4, + coli, + "all") + trans_tbl(3, which(tbl$fullname %like% '^Salmonella Typhi'), - c(carbapenems, fluoroquinolones)) - trans_tbl(4, + c(carbapenems, fluoroquinolones), + "any") + trans_tbl(3, which(tbl$fullname %like% '^Haemophilus influenzae'), - c(cephalosporins_3rd, carbapenems, fluoroquinolones)) - trans_tbl(4, + c(cephalosporins_3rd, carbapenems, fluoroquinolones), + "any") + trans_tbl(3, which(tbl$fullname %like% '^Moraxella catarrhalis'), - c(cephalosporins_3rd, fluoroquinolones)) - trans_tbl(4, + c(cephalosporins_3rd, fluoroquinolones), + "any") + trans_tbl(3, which(tbl$fullname %like% '^Neisseria meningitidis'), - c(cephalosporins_3rd, fluoroquinolones)) - trans_tbl(4, + c(cephalosporins_3rd, fluoroquinolones), + "any") + trans_tbl(3, which(tbl$fullname %like% '^Neisseria gonorrhoeae'), - azit) + azit, + "any") # Table 6 - trans_tbl(4, + trans_tbl(3, which(tbl$fullname %like% '^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)'), - c(vanc, teic, dapt, line, qida, tige)) - trans_tbl(4, + c(vanc, teic, dapt, line, qida, tige), + "any") + trans_tbl(3, which(tbl$genus == 'Corynebacterium'), - c(vanc, teic, dapt, line, qida, tige)) - trans_tbl(4, + c(vanc, teic, dapt, line, qida, tige), + "any") + trans_tbl(3, which(tbl$fullname %like% '^Streptococcus pneumoniae'), - c(carbapenems, vanc, teic, dapt, line, qida, tige, rifa)) - trans_tbl(4, # Sr. groups A/B/C/G + c(carbapenems, vanc, teic, dapt, line, qida, tige, rifa), + "any") + trans_tbl(3, # Sr. groups A/B/C/G which(tbl$fullname %like% '^Streptococcus (pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)'), - c(peni, cephalosporins, vanc, teic, dapt, line, qida, tige)) - trans_tbl(4, + c(peni, cephalosporins, vanc, teic, dapt, line, qida, tige), + "any") + trans_tbl(3, which(tbl$genus == 'Enterococcus'), - c(dapt, line, tige, teic)) - trans_tbl(4, + c(dapt, line, tige, teic), + "any") + trans_tbl(3, which(tbl$fullname %like% '^Enterococcus faecalis'), - c(ampi, amox)) + c(ampi, amox), + "any") # Table 7 - trans_tbl(4, + trans_tbl(3, which(tbl$genus == 'Bacteroides'), - metr) - trans_tbl(4, + metr, + "any") + trans_tbl(3, which(tbl$fullname %like% '^Clostridium difficile'), - c(metr, vanc)) + c(metr, vanc), + "any") } if (guideline$country$code == 'de') { @@ -325,112 +346,88 @@ MDRO <- function(tbl, carbapenems <- carbapenems[!is.na(carbapenems)] # Table 1 - tbl[which( - tbl$family == 'Enterobacteriaceae' - & rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1 - & rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1 - ), 'MDRO'] <- 4 - tbl[which( - tbl$family == 'Enterobacteriaceae' - & rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1 - ), 'MDRO'] <- 3 - # rest is negative - tbl[which( - tbl$family == 'Enterobacteriaceae' - & tbl$MDRO == 1 - ), 'MDRO'] <- 2 + trans_tbl(3, + which(tbl$family == 'Enterobacteriaceae'), + c(aminoglycosides, fluoroquinolones), + "all") + + trans_tbl(2, + which(tbl$family == 'Enterobacteriaceae'), + c(carbapenems), + "any") # Table 2 - tbl[which( - tbl$genus == 'Acinetobacter' - & rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1 - ), 'MDRO'] <- 3 - tbl[which( - tbl$genus == 'Acinetobacter' - & rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1 - & rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1 - ), 'MDRO'] <- 4 - # rest of Acinetobacter is negative - tbl[which( - tbl$genus == 'Acinetobacter' - & tbl$MDRO == 1 - ), 'MDRO'] <- 2 + trans_tbl(2, + which(tbl$genus == 'Acinetobacter'), + c(carbapenems), + "any") + trans_tbl(3, + which(tbl$genus == 'Acinetobacter'), + c(aminoglycosides, fluoroquinolones), + "all") - tbl[which( - tbl$fullname %like% 'Stenotrophomonas maltophilia' - & tbl[, trsu] == 'R' - ), 'MDRO'] <- 4 - # rest of Stenotrophomonas is negative - tbl[which( - tbl$fullname %like% 'Stenotrophomonas maltophilia' - & tbl$MDRO == 1 - ), 'MDRO'] <- 2 + trans_tbl(3, + which(tbl$fullname %like% '^Stenotrophomonas maltophilia'), + trsu, + "all") - tbl <- tbl %>% mutate( - psae = 0, - psae = ifelse(mero == "R" | imip == "R", psae + 1, psae), - psae = ifelse(gent == "R" & tobr == "R", psae + 1, psae), - psae = ifelse(cipr == "R", psae + 1, psae), - psae = ifelse(cfta == "R", psae + 1, psae), - psae = ifelse(pita == "R", psae + 1, psae), - psae = ifelse(is.na(psae), 0, psae) - ) + if (!is.na(mero) & !is.na(imip) + & !is.na(gent) & !is.na(tobr) + & !is.na(cipr) + & !is.na(cfta) + & !is.na(pita) ) { + tbl <- tbl %>% mutate( + psae = 0, + psae = ifelse(mero == "R" | imip == "R", psae + 1, psae), + psae = ifelse(gent == "R" & tobr == "R", psae + 1, psae), + psae = ifelse(cipr == "R", psae + 1, psae), + psae = ifelse(cfta == "R", psae + 1, psae), + psae = ifelse(pita == "R", psae + 1, psae), + psae = ifelse(is.na(psae), 0, psae) + ) + } else { + tbl$psae <- 0 + } tbl[which( tbl$fullname %like% 'Pseudomonas aeruginosa' & tbl$psae >= 3 - ), 'MDRO'] <- 4 - # rest of Pseudomonas is negative - tbl[which( - tbl$fullname %like% 'Pseudomonas aeruginosa' - & tbl$MDRO == 1 - ), 'MDRO'] <- 2 + ), 'MDRO'] <- 3 # Table 3 - tbl[which( - tbl$fullname %like% 'Streptococcus pneumoniae' - & tbl[, peni] == 'R' - ), 'MDRO'] <- 4 - tbl[which( - tbl$fullname %like% 'Streptococcus pneumoniae' - & tbl[, vanc] == 'R' - ), 'MDRO'] <- 4 - # rest of Streptococcus pneumoniae is negative - tbl[which( - tbl$fullname %like% 'Streptococcus pneumoniae' - & tbl$MDRO == 1 - ), 'MDRO'] <- 2 - - tbl[which( - tbl$fullname %like% 'Enterococcus faecium' - & rowSums(tbl[, c(peni, vanc)] == 'R', na.rm = TRUE) >= 1 - ), 'MDRO'] <- 4 - # rest of Enterococcus faecium is negative - tbl[which( - tbl$fullname %like% 'Enterococcus faecium' - & tbl$MDRO == 1 - ), 'MDRO'] <- 2 + trans_tbl(3, + which(tbl$fullname %like% 'Streptococcus pneumoniae'), + peni, + "all") + trans_tbl(3, + which(tbl$fullname %like% 'Streptococcus pneumoniae'), + vanc, + "all") + trans_tbl(3, + which(tbl$fullname %like% 'Enterococcus faecium'), + c(peni, vanc), + "all") } factor(x = tbl$MDRO, - levels = c(1:4), - labels = c('Not evaluated', 'Negative', 'Unconfirmed', 'Positive'), + levels = 1:3, + labels = c('Negative', 'Positive, unconfirmed', 'Positive'), ordered = TRUE) } -#' @rdname MDRO +#' @rdname mdro #' @export -BRMO <- function(tbl, country = "nl", ...) { - MDRO(tbl = tbl, country = "nl", ...) +brmo <- function(..., country = "nl") { + mdro(..., country = "nl") } -#' @rdname MDRO +#' @rdname mdro #' @export -MRGN <- function(tbl, country = "de", ...) { - MDRO(tbl = tbl, country = "de", ...) +mrgn <- function(tbl, country = "de", ...) { + mdro(tbl = tbl, country = "de", ...) } -#' @rdname MDRO +#' @rdname mdro #' @export -EUCAST_exceptional_phenotypes <- function(tbl, country = "EUCAST", ...) { - MDRO(tbl = tbl, country = "EUCAST", ...) +eucast_exceptional_phenotypes <- function(tbl, country = "EUCAST", ...) { + mdro(tbl = tbl, country = "EUCAST", ...) } diff --git a/R/read.4d.R b/R/read.4d.R index a1b88ba9..34e75626 100644 --- a/R/read.4d.R +++ b/R/read.4d.R @@ -110,7 +110,7 @@ read.4D <- function(file, # backup original column names colnames.bak <- toupper(colnames(data_4D)) - colnames.bak[colnames.bak == "AGE"] <- NULL + colnames.bak[colnames.bak == "AGE"] <- NA_character_ # rename of columns colnames(data_4D) <- gsub("patientnr", "patient_id", colnames(data_4D), fixed = TRUE) @@ -162,9 +162,18 @@ read.4D <- function(file, message("OK\nSetting original column names as label... ", appendLF = FALSE) } for (i in 1:ncol(data_4D)) { - attr(data_4D[, i], "label") <- colnames.bak[i] + if (!is.na(colnames.bak[i])) { + attr(data_4D[, i], "label") <- colnames.bak[i] + } } + if (info == TRUE) { + message("OK\nSetting query as label to data.frame... ", appendLF = FALSE) + } + qry <- readLines(con <- file(file, open="r"))[1] + close(con) + attr(data_4D, "label") <- qry + if (info == TRUE) { message("OK") } diff --git a/man/EUCAST.Rd b/man/eucast_rules.Rd old mode 100755 new mode 100644 similarity index 96% rename from man/EUCAST.Rd rename to man/eucast_rules.Rd index 561b3e9b..2dad25c4 --- a/man/EUCAST.Rd +++ b/man/eucast_rules.Rd @@ -1,6 +1,7 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/eucast.R -\name{EUCAST_rules} +% Please edit documentation in R/eucast_rules.R +\name{eucast_rules} +\alias{eucast_rules} \alias{EUCAST_rules} \alias{interpretive_reading} \title{EUCAST rules} @@ -22,7 +23,7 @@ } } \usage{ -EUCAST_rules(tbl, col_mo = NULL, info = TRUE, +eucast_rules(tbl, col_mo = NULL, info = TRUE, rules = c("breakpoints", "expert", "other", "all"), verbose = FALSE, amcl = "amcl", amik = "amik", amox = "amox", ampi = "ampi", azit = "azit", azlo = "azlo", aztr = "aztr", cefa = "cefa", @@ -41,6 +42,8 @@ EUCAST_rules(tbl, col_mo = NULL, info = TRUE, tetr = "tetr", tica = "tica", tige = "tige", tobr = "tobr", trim = "trim", trsu = "trsu", vanc = "vanc", col_bactid = NULL) +EUCAST_rules(...) + interpretive_reading(...) } \arguments{ @@ -58,7 +61,7 @@ interpretive_reading(...) \item{col_bactid}{deprecated, use \code{col_mo} instead.} -\item{...}{parameters that are passed on to \code{EUCAST_rules}} +\item{...}{parameters that are passed on to \code{eucast_rules}} } \value{ The input of \code{tbl}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with verbose info. @@ -138,7 +141,7 @@ Abbrevations of the column containing antibiotics in the form: \strong{abbreviat } \examples{ -a <- EUCAST_rules(septic_patients) +a <- eucast_rules(septic_patients) a <- data.frame(mo = c("Staphylococcus aureus", "Enterococcus faecalis", @@ -162,7 +165,7 @@ a # 4 Klebsiella pneumoniae - - - - - S S # 5 Pseudomonas aeruginosa - - - - - S S -b <- EUCAST_rules(a, "mo") # 18 results are forced as R or S +b <- eucast_rules(a, "mo") # 18 results are forced as R or S b # mo vanc amox coli cfta cfur peni cfox diff --git a/man/MDRO.Rd b/man/mdro.Rd old mode 100755 new mode 100644 similarity index 95% rename from man/MDRO.Rd rename to man/mdro.Rd index a779b1dd..fc48e1e4 --- a/man/MDRO.Rd +++ b/man/mdro.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/mdro.R -\name{MDRO} -\alias{MDRO} -\alias{BRMO} -\alias{MRGN} -\alias{EUCAST_exceptional_phenotypes} +\name{mdro} +\alias{mdro} +\alias{brmo} +\alias{mrgn} +\alias{eucast_exceptional_phenotypes} \title{Determine multidrug-resistant organisms (MDRO)} \usage{ -MDRO(tbl, country = NULL, col_mo = NULL, info = TRUE, +mdro(tbl, country = NULL, col_mo = NULL, info = TRUE, amcl = "amcl", amik = "amik", amox = "amox", ampi = "ampi", azit = "azit", aztr = "aztr", cefa = "cefa", cfra = "cfra", cfep = "cfep", cfot = "cfot", cfox = "cfox", cfta = "cfta", @@ -25,11 +25,11 @@ MDRO(tbl, country = NULL, col_mo = NULL, info = TRUE, tobr = "tobr", trim = "trim", trsu = "trsu", vanc = "vanc", col_bactid = NULL) -BRMO(tbl, country = "nl", ...) +brmo(..., country = "nl") -MRGN(tbl, country = "de", ...) +mrgn(tbl, country = "de", ...) -EUCAST_exceptional_phenotypes(tbl, country = "EUCAST", ...) +eucast_exceptional_phenotypes(tbl, country = "EUCAST", ...) } \arguments{ \item{tbl}{table with antibiotic columns, like e.g. \code{amox} and \code{amcl}} @@ -165,7 +165,7 @@ EUCAST_exceptional_phenotypes(tbl, country = "EUCAST", ...) \item{...}{parameters that are passed on to methods} } \value{ -Ordered factor with levels \code{Unknown < Negative < Unconfirmed < Positive}. +Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}. } \description{ Determine which isolates are multidrug-resistant organisms (MDRO) according to country-specific guidelines. @@ -245,6 +245,6 @@ Abbrevations of the column containing antibiotics in the form: \strong{abbreviat library(dplyr) septic_patients \%>\% - mutate(EUCAST = MDRO(.), - BRMO = BRMO(.)) + mutate(EUCAST = mdro(.), + BRMO = brmo(.)) } diff --git a/tests/testthat/test-eucast.R b/tests/testthat/test-eucast_rules.R similarity index 80% rename from tests/testthat/test-eucast.R rename to tests/testthat/test-eucast_rules.R index ad2749f4..3ea743c9 100755 --- a/tests/testthat/test-eucast.R +++ b/tests/testthat/test-eucast_rules.R @@ -1,11 +1,11 @@ -context("eucast.R") +context("eucast_rules.R") test_that("EUCAST rules work", { - expect_error(suppressWarnings(EUCAST_rules(septic_patients, col_mo = "Non-existing"))) + expect_error(suppressWarnings(eucast_rules(septic_patients, col_mo = "Non-existing"))) expect_identical(colnames(septic_patients), - colnames(suppressWarnings(EUCAST_rules(septic_patients)))) + colnames(suppressWarnings(eucast_rules(septic_patients)))) a <- data.frame(mo = c("KLEPNE", # Klebsiella pneumoniae "PSEAER", # Pseudomonas aeruginosa @@ -17,7 +17,8 @@ test_that("EUCAST rules work", { "ENTAER"), # Enterobacter aerogenes amox = "R", # Amoxicillin stringsAsFactors = FALSE) - expect_identical(suppressWarnings(EUCAST_rules(a, "mo", info = FALSE)), b) + expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) + expect_identical(suppressWarnings(eucast_rules(a, "mo", info = TRUE)), b) expect_identical(suppressWarnings(interpretive_reading(a, "mo", info = TRUE)), b) a <- data.frame(mo = c("STAAUR", # Staphylococcus aureus @@ -28,7 +29,7 @@ test_that("EUCAST rules work", { "STCGRA"), # Streptococcus pyognenes (Lancefield Group A) coli = "R", # Colistin stringsAsFactors = FALSE) - expect_equal(suppressWarnings(EUCAST_rules(a, "mo", info = FALSE)), b) + expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) # piperacillin must be R in Enterobacteriaceae when tica is R library(dplyr) @@ -36,7 +37,7 @@ test_that("EUCAST rules work", { septic_patients %>% mutate(tica = as.rsi("R"), pipe = as.rsi("S")) %>% - EUCAST_rules(col_mo = "mo") %>% + eucast_rules(col_mo = "mo") %>% left_join_microorganisms() %>% filter(family == "Enterobacteriaceae") %>% pull(pipe) %>% @@ -51,12 +52,12 @@ test_that("EUCAST rules work", { eryt, azit = as.rsi("R"), clar = as.rsi("R")) %>% - EUCAST_rules(col_mo = "mo") %>% + eucast_rules(col_mo = "mo") %>% pull(clar)) b <- suppressWarnings( septic_patients %>% select(mo, eryt) %>% - EUCAST_rules(col_mo = "mo") %>% + eucast_rules(col_mo = "mo") %>% pull(eryt)) expect_identical(a[!is.na(b)], @@ -64,7 +65,7 @@ test_that("EUCAST rules work", { # amox is inferred by benzylpenicillin in Kingella kingae expect_equal( - as.list(EUCAST_rules( + as.list(eucast_rules( data.frame(mo = as.mo("Kingella kingae"), peni = "S", amox = "-", @@ -72,6 +73,6 @@ test_that("EUCAST rules work", { , info = FALSE))$amox, "S") - expect_output(suppressWarnings(EUCAST_rules(septic_patients, verbose = TRUE))) + expect_output(suppressWarnings(eucast_rules(septic_patients, verbose = TRUE))) }) diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R index 9a5b0339..4210cb99 100755 --- a/tests/testthat/test-mdro.R +++ b/tests/testthat/test-mdro.R @@ -1,30 +1,30 @@ context("mdro.R") -test_that("MDRO works", { +test_that("mdro works", { library(dplyr) - expect_error(suppressWarnings(MDRO(septic_patients, "invalid", col_bactid = "mo", info = TRUE))) - expect_error(suppressWarnings(MDRO(septic_patients, "fr", col_bactid = "mo", info = TRUE))) - expect_error(suppressWarnings(MDRO(septic_patients, country = c("de", "nl"), info = TRUE))) - expect_error(suppressWarnings(MDRO(septic_patients, col_mo = "invalid", info = TRUE))) + expect_error(suppressWarnings(mdro(septic_patients, "invalid", col_bactid = "mo", info = TRUE))) + expect_error(suppressWarnings(mdro(septic_patients, "fr", col_bactid = "mo", info = TRUE))) + expect_error(suppressWarnings(mdro(septic_patients, country = c("de", "nl"), info = TRUE))) + expect_error(suppressWarnings(mdro(septic_patients, col_mo = "invalid", info = TRUE))) - outcome <- suppressWarnings(MDRO(septic_patients)) - outcome <- suppressWarnings(EUCAST_exceptional_phenotypes(septic_patients, info = TRUE)) + outcome <- suppressWarnings(mdro(septic_patients)) + outcome <- suppressWarnings(eucast_exceptional_phenotypes(septic_patients, info = TRUE)) # check class expect_equal(outcome %>% class(), c('ordered', 'factor')) - outcome <- suppressWarnings(MDRO(septic_patients, "nl", info = TRUE)) + outcome <- suppressWarnings(mdro(septic_patients, "nl", info = TRUE)) # check class expect_equal(outcome %>% class(), c('ordered', 'factor')) # septic_patients should have these finding using Dutch guidelines expect_equal(outcome %>% freq() %>% pull(count), - c(1167, 817, 14, 2)) # 1167 not eval., 817 neg, 14 pos, 2 unconfirmed + c(19989, 9, 2)) # 1167 not eval., 817 neg, 14 pos, 2 unconfirmed - expect_equal(BRMO(septic_patients, info = FALSE), MDRO(septic_patients, "nl", info = FALSE)) + expect_equal(brmo(septic_patients, info = FALSE), mdro(septic_patients, "nl", info = FALSE)) # still working on German guidelines - expect_error(suppressWarnings(MRGN(septic_patients, info = TRUE))) + expect_error(suppressWarnings(mrgn(septic_patients, info = TRUE))) })