diff --git a/DESCRIPTION b/DESCRIPTION index fc37da37..ec73018b 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.4.0.9003 -Date: 2018-10-16 +Version: 0.4.0.9004 +Date: 2018-10-17 Title: Antimicrobial Resistance Analysis Authors@R: c( person( @@ -47,6 +47,7 @@ Depends: Imports: backports, curl, + crayon (>= 1.3.0), data.table (>= 1.9.0), dplyr (>= 0.7.0), hms, diff --git a/NAMESPACE b/NAMESPACE index c99c60e9..42c2a039 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -161,6 +161,13 @@ exportMethods(skewness.default) exportMethods(skewness.matrix) exportMethods(summary.mic) exportMethods(summary.rsi) +importFrom(crayon,bgGreen) +importFrom(crayon,bgRed) +importFrom(crayon,bgYellow) +importFrom(crayon,black) +importFrom(crayon,blue) +importFrom(crayon,bold) +importFrom(crayon,green) importFrom(curl,nslookup) importFrom(data.table,as.data.table) importFrom(data.table,data.table) diff --git a/NEWS.md b/NEWS.md index 96148302..53fbf068 100755 --- a/NEWS.md +++ b/NEWS.md @@ -4,13 +4,21 @@ * Function `count_all` to get all available isolates (that like all `portion_*` and `count_*` functions also supports `summarise` and `group_by`), the old `n_rsi` is now an alias of `count_all` #### Changed +* Big changes to the `EUCAST_rules` function: + * It 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) + * There's better error handling when rules cannot be applied (i.e. new values could not be inserted) + * A new `verbose` parameter can be set to `TRUE` to get very specific messages about which columns and rows were affected + * The amount of affected values will now only be measured once per row/column combination + * Data set `septic_patients` now reflects these changes * Added parameter `combine_IR` (TRUE/FALSE) to functions `portion_df` and `count_df`, to indicate that all values of I and R must be merged into one, so the output only consists of S vs. IR (susceptible vs. non-susceptible) * Fix for `portion_*(..., as_percent = TRUE)` when minimal amount of isolates would not be met * Using `portion_*` functions now throws a warning when total available isolate is below parameter `minimum` -* `as.mo` will not set package name as attribute anymore +* Functions `as.mo`, `as.rsi` and `as.mic` will not set package name as attribute anymore +* Data set `septic_patients` is now a `data.frame`, not a tibble anymore * Check for `hms::is.hms` in frequency tables * 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 * Support for class `difftime` in frequency tables * Support for named vectors of class `mo`, useful for `top_freq()` * AI improvements for `as.mo`: @@ -22,6 +30,7 @@ * In `g.test`, when `sum(x)` is below 1000, suggest Fisher's Exact Test #### Other +* New dependency on package `crayon`, to support formatted text in the console * Updated vignettes to comply with README diff --git a/R/data.R b/R/data.R index da83228b..d919ffdb 100755 --- a/R/data.R +++ b/R/data.R @@ -186,7 +186,7 @@ #' Data set with 2000 blood culture isolates of septic patients #' #' An anonymised data set containing 2,000 microbial blood culture isolates with their full antibiograms found in septic patients in 4 different hospitals in the Netherlands, between 2001 and 2017. It is true, genuine data. This \code{data.frame} can be used to practice AMR analysis. For examples, press F1. -#' @format A \code{\link{tibble}} with 2,000 observations and 49 variables: +#' @format A \code{\link{data.frame}} with 2,000 observations and 49 variables: #' \describe{ #' \item{\code{date}}{date of receipt at the laboratory} #' \item{\code{hospital_id}}{ID of the hospital, from A to D} @@ -199,7 +199,6 @@ #' \item{\code{mo}}{ID of microorganism, see \code{\link{microorganisms}}} #' \item{\code{peni:rifa}}{40 different antibiotics with class \code{rsi} (see \code{\link{as.rsi}}); these column names occur in \code{\link{antibiotics}} data set and can be translated with \code{\link{abname}}} #' } -# source MOLIS (LIS of Certe) - \url{https://www.certe.nl} #' @examples #' # ----------- # #' # PREPARATION # diff --git a/R/eucast.R b/R/eucast.R index 69a7cf8a..3409b7fc 100755 --- a/R/eucast.R +++ b/R/eucast.R @@ -16,19 +16,20 @@ # GNU General Public License for more details. # # ==================================================================== # -#' EUCAST expert rules +#' EUCAST rules #' -#' Apply expert rules (like intrinsic resistance), as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}. +#' Apply susceptibility rules as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}. This includes (1) expert rules, (2) intrinsic resistance and (3) inferred resistance as defined in their breakpoint tables. #' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl} #' @param col_mo column name of the microbial ID in \code{tbl} - values in this column should be present in \code{microorganisms$mo}, see \code{\link{microorganisms}} #' @param info print progress -#' @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,peni,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc 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 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,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc 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 col_bactid Deprecated. Use \code{col_mo} instead. +#' @param verbose a logical to indicate whether extensive info should be printed to the console about which rows and columns are effected with their old and new values #' @param ... parameters that are passed on to \code{EUCAST_rules} #' @section Antibiotics: #' Abbrevations of the column containing antibiotics: #' -#' \strong{amcl}: amoxicillin and beta-lactamase inhibitor (\emph{J01CR02}), +#' \strong{amcl}: amoxicillin+clavulanic acid (\emph{J01CR02}), #' \strong{amik}: amikacin (\emph{J01GB06}), #' \strong{amox}: amoxicillin (\emph{J01CA04}), #' \strong{ampi}: ampicillin (\emph{J01CA01}), @@ -57,7 +58,7 @@ #' \strong{fosf}: fosfomycin (\emph{J01XX01}), #' \strong{fusi}: fusidic acid (\emph{J01XC01}), #' \strong{gent}: gentamicin (\emph{J01GB03}), -#' \strong{imip}: imipenem and cilastatin (\emph{J01DH51}), +#' \strong{imip}: imipenem (\emph{J01DH51}), #' \strong{kana}: kanamycin (\emph{J01GB04}), #' \strong{levo}: levofloxacin (\emph{J01MA12}), #' \strong{linc}: lincomycin (\emph{J01FF02}), @@ -73,8 +74,8 @@ #' \strong{norf}: norfloxacin (\emph{J01MA06}), #' \strong{novo}: novobiocin (an ATCvet code: \emph{QJ01XX95}), #' \strong{oflo}: ofloxacin (\emph{J01MA01}), -#' \strong{peni}: penicillins, combinations with other antibacterials (\emph{J01RA01}), -#' \strong{pita}: piperacillin and beta-lactamase inhibitor (\emph{J01CR05}), +#' \strong{peni}: penicillin (\emph{J01RA01}), +#' \strong{pita}: piperacillin+tazobactam (\emph{J01CR05}), #' \strong{poly}: polymyxin B (\emph{J01XB02}), #' \strong{pris}: pristinamycin (\emph{J01FG01}), #' \strong{qida}: quinupristin/dalfopristin (\emph{J01FG02}), @@ -92,15 +93,25 @@ #' @keywords interpretive eucast reading resistance #' @rdname EUCAST #' @export -#' @importFrom dplyr %>% left_join select +#' @importFrom dplyr %>% select pull +#' @importFrom crayon bold bgGreen bgYellow bgRed black green blue #' @return table with edited variables of antibiotics. #' @source -#' EUCAST Expert Rules Version 2.0: \cr -#' Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility testing.} \emph{Clin Microbiol Infect.} 2013;19(2):141-60. \cr -#' \url{https://doi.org/10.1111/j.1469-0691.2011.03703.x} \cr -#' \cr -#' EUCAST Expert Rules Version 3.1 (Intrinsic Resistance and Exceptional Phenotypes Tables): \cr -#' \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf} +#' \itemize{ +#' \item{ +#' EUCAST Expert Rules. Version 2.0, 2012. \cr +#' Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility testing.} \emph{Clin Microbiol Infect.} 2013;19(2):141-60. \cr +#' \url{https://doi.org/10.1111/j.1469-0691.2011.03703.x} +#' } +#' \item{ +#' EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. \cr +#' \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf} +#' } +#' \item{ +#' EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 8.1, 2018. \cr +#' \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_8.1_Breakpoint_Tables.xlsx} +#' } +#' } #' @examples #' a <- EUCAST_rules(septic_patients) #' @@ -167,6 +178,7 @@ EUCAST_rules <- function(tbl, norf = 'norf', novo = 'novo', oflo = 'oflo', + oxac = 'oxac', peni = 'peni', pita = 'pita', poly = 'poly', @@ -183,9 +195,11 @@ EUCAST_rules <- function(tbl, trim = 'trim', trsu = 'trsu', vanc = 'vanc', - col_bactid = 'bactid') { + col_bactid = 'bactid', + verbose = FALSE) { - EUCAST_VERSION <- "3.1" + EUCAST_VERSION_BREAKPOINTS <- "8.1, 2018" + EUCAST_VERSION_EXPERT_RULES <- "3.1, 2016" if (col_bactid %in% colnames(tbl)) { col_mo <- col_bactid @@ -195,12 +209,32 @@ EUCAST_rules <- function(tbl, stop('Column ', col_mo, ' not found.', call. = FALSE) } + warned <- FALSE + changed_results <- 0 + + txt_error <- function() { cat("", bgRed(black(" ERROR ")), "\n") } + txt_warning <- function() { if (warned == FALSE) { cat("", bgYellow(black(" WARNING ")), "\n") }; warned <<- TRUE } + txt_ok <- function() { + if (warned == FALSE) { + if (changed_results > 0) { + if (changed_results == 1) { + cat(blue(" (1 change)\n")) + } else { + cat(blue(paste0(" (", changed_results, " changes)\n"))) + } + } else { + cat(green(" (no changes)\n")) + } + warned <<- FALSE + } + } + # check columns col.list <- c(amcl, amik, amox, ampi, azit, azlo, aztr, cefa, cfra, cfep, cfot, cfox, 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, - novo, norf, oflo, peni, pita, poly, pris, qida, rifa, roxi, siso, + novo, norf, oflo, oxac, peni, pita, poly, pris, qida, rifa, roxi, siso, teic, tetr, tica, tige, tobr, trim, trsu, vanc) col.list <- check_available_columns(tbl = tbl, col.list = col.list, info = info) amcl <- col.list[amcl] @@ -248,6 +282,7 @@ EUCAST_rules <- function(tbl, norf <- col.list[norf] novo <- col.list[novo] oflo <- col.list[oflo] + oxac <- col.list[oxac] peni <- col.list[peni] pita <- col.list[pita] poly <- col.list[poly] @@ -265,18 +300,52 @@ EUCAST_rules <- function(tbl, trsu <- col.list[trsu] vanc <- col.list[vanc] - total <- 0 - total_rows <- integer(0) + amount_changed <- 0 + amount_affected_rows <- integer(0) + verbose_info <- "" # helper function for editing the table - edit_rsi <- function(to, rows, cols, EUCAST_rule = "") { - # later: use this as attribute for the edited observations - EUCAST_rule <- trimws(paste("EUCAST rule", EUCAST_rule)) + edit_rsi <- function(to, rule, rows, cols) { cols <- cols[!is.na(cols)] if (length(rows) > 0 & length(cols) > 0) { - tbl[rows, cols] <<- to - total <<- total + (length(rows) * length(cols)) - total_rows <<- c(total_rows, rows) + before <- as.character(unlist(as.list(tbl_original[rows, cols]))) + tryCatch( + # insert into original table + tbl_original[rows, cols] <<- to, + warning = function(w) { + if (w$message %like% 'invalid factor level') { + warning('Value "', to, '" could not be applied to column(s) `', paste(cols, collapse = '`, `'), '` because this value is not an existing factor level.', call. = FALSE) + } else { + warning(w$message, call. = FALSE) + } + txt_warning() + }, + error = function(e) { + txt_error() + stop(e, call. = FALSE) + } + ) + after <- as.character(unlist(as.list(tbl_original[rows, cols]))) + amount_changed <<- amount_changed + sum(before != after, na.rm = TRUE) + amount_affected_rows <<- unique(c(amount_affected_rows, rows)) + changed_results <<- changed_results + sum(before != after, na.rm = TRUE) # will be reset at start of every rule + + if (verbose == TRUE) { + verbose_info <<- paste0(verbose_info, + "\n\nRule Type: ", rule[1], + "\nRule Set: ", rule[2], + "\nEffect: Forced '", to, "' (", + "actually changed ", sum(before != after, na.rm = TRUE), + "): cols '", paste(cols, collapse = "', '"), + "' of rows ", paste(rows, collapse = ", ")) + } + } + } + na.rm <- function(col) { + if (is.na(col)) { + "" + } else { + col } } @@ -286,7 +355,8 @@ EUCAST_rules <- function(tbl, col_mo_original <- tbl %>% pull(col_mo) tbl[, col_mo] <- as.mo(tbl[, col_mo]) } - tbl <- tbl %>% left_join_microorganisms(by = col_mo, suffix = c("_tempmicroorganisms", "")) + tbl_original <- tbl + tbl <- tbl %>% left_join_microorganisms(by = col_mo, suffix = c("_oldcols", "")) # antibiotic classes aminoglycosides <- c(tobr, gent, kana, neom, neti, siso) @@ -300,93 +370,815 @@ EUCAST_rules <- function(tbl, aminopenicillins <- c(ampi, amox) ureidopenicillins <- c(pita, azlo, mezl) fluoroquinolones <- c(oflo, cipr, norf, levo, moxi) + all_betalactam <- c(aminopenicillins, ureidopenicillins, cephalosporins, carbapenems, amcl, oxac, clox, peni) if (info == TRUE) { - cat( - paste0( - '\nApplying rules to ', - tbl[!is.na(tbl$genus),] %>% nrow() %>% format(big.mark = ","), - ' rows according to "EUCAST Expert Rules Version ', EUCAST_VERSION, '"\n') - ) + cat("Rules by the European Committee on Antimicrobial Susceptibility Testing (EUCAST)\n") } + # since ampicillin ^= amoxicillin, get the first from the latter + if (!is.na(ampi) & !is.na(amox)) { + rule_group <- "Ampicillin susceptibility" + rule <- "Get ampicillin results from amoxicillin where ampicillin is missing" + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl[, amox] == 'S' & !tbl[, ampi] %in% c("S", "I", "R")), + cols = ampi) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl[, amox] == 'I' & !tbl[, ampi] %in% c("S", "I", "R")), + cols = ampi) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl[, amox] == 'R' & !tbl[, ampi] %in% c("S", "I", "R")), + cols = ampi) + } + + # BREAKPOINTS ------------------------------------------------------------- + + if (info == TRUE) { + cat(bold(paste0('\nEUCAST Clinical Breakpoints (v', EUCAST_VERSION_BREAKPOINTS, ')\n'))) + } + rule_group <- "Breakpoints" + + # Enterobacteriales (Order) ---- + rule <- 'Enterobacteriales (Order)' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + + if (!is.na(ampi)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$order == 'Enterobacteriales' + & tbl[, ampi] == 'S'), + cols = amox) + } + if (!is.na(ampi)) { + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$order == 'Enterobacteriales' + & tbl[, ampi] == 'I'), + cols = amox) + } + if (!is.na(ampi)) { + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$order == 'Enterobacteriales' + & tbl[, ampi] == 'R'), + cols = amox) + } + if (info == TRUE) { + txt_ok() + } + # Staphylococcus ---- + rule <- 'Staphylococcus' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni) & !is.na(cfox)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, peni] == 'S' + & tbl[, cfox] == 'S'), + cols = c(ampi, amox, pita, tica)) + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, peni] == 'R' + & tbl[, cfox] == 'S'), + cols = c(oxac, clox)) + } + if (!is.na(cfox)) { + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, cfox] == 'R'), + cols = all_betalactam) + } + if (!is.na(ampi)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Staphylococcus saprophyticus" + & tbl[, ampi] == 'S'), + cols = c(ampi, amox, amcl, pita)) + } + if (!is.na(cfox)) { + # inferred from cefoxitin + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, cfox] == 'S'), + cols = c(carbapenems, cephalosporins[cephalosporins != na.rm(cfta)])) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, cfox] == 'I'), + cols = c(carbapenems, cephalosporins[cephalosporins != na.rm(cfta)])) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, cfox] == 'R'), + cols = c(carbapenems, cephalosporins[cephalosporins != na.rm(cfta)])) + } + if (!is.na(norf)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, norf] == 'S'), + cols = c(cipr, levo, moxi, oflo)) + } + if (!is.na(eryt)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, eryt] == 'S'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, eryt] == 'I'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, eryt] == 'R'), + cols = c(azit, clar, roxi)) + } + if (!is.na(tetr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Staphylococcus" + & tbl[, tetr] == 'S'), + cols = c(doxy, mino)) + } + if (info == TRUE) { + txt_ok() + } + # Enterococcus ---- + rule <- 'Enterococcus' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni)) { + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Enterococcus faecium" + & tbl[, peni] == 'R'), + cols = all_betalactam) + } + if (!is.na(ampi)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Enterococcus" + & tbl[, ampi] == 'S'), + cols = c(amox, amcl, pita)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Enterococcus" + & tbl[, ampi] == 'I'), + cols = c(amox, amcl, pita)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Enterococcus" + & tbl[, ampi] == 'R'), + cols = c(amox, amcl, pita)) + } + if (!is.na(norf)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Enterococcus" + & tbl[, norf] == 'S'), + cols = c(cipr, levo)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Enterococcus" + & tbl[, norf] == 'I'), + cols = c(cipr, levo)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Enterococcus" + & tbl[, norf] == 'R'), + cols = c(cipr, levo)) + } + if (info == TRUE) { + txt_ok() + } + # Streptococcus A, B, C, G---- + rule <- 'Streptococcus A, B, C, G' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, peni] == 'S'), + cols = c(aminopenicillins, ureidopenicillins, cephalosporins, carbapenems, clox, amcl)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, peni] == 'I'), + cols = c(aminopenicillins, ureidopenicillins, cephalosporins, carbapenems, clox, amcl)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, peni] == 'R'), + cols = c(aminopenicillins, ureidopenicillins, cephalosporins, carbapenems, clox, amcl)) + } + if (!is.na(norf)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, norf] == 'S'), + cols = c(levo, moxi)) + } + if (!is.na(eryt)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, eryt] == 'S'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, eryt] == 'I'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, eryt] == 'R'), + cols = c(azit, clar, roxi)) + } + if (!is.na(tetr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)" + & tbl[, tetr] == 'S'), + cols = c(doxy, mino)) + } + if (info == TRUE) { + txt_ok() + } + # Streptococcus pneumoniae ---- + rule <- 'Streptococcus pneumoniae' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, peni] == 'S'), + cols = c(ampi, amox, amcl, pita)) + } + if (!is.na(ampi)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, ampi] == 'S'), + cols = c(ampi, amox, amcl, pita)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, ampi] == 'I'), + cols = c(ampi, amox, amcl, pita)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, ampi] == 'R'), + cols = c(ampi, amox, amcl, pita)) + } + if (!is.na(norf)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, norf] == 'S'), + cols = c(levo, moxi)) + } + if (!is.na(eryt)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, eryt] == 'S'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, eryt] == 'I'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, eryt] == 'R'), + cols = c(azit, clar, roxi)) + } + if (!is.na(tetr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Streptococcus pneumoniae" + & tbl[, tetr] == 'S'), + cols = c(doxy, mino)) + } + if (info == TRUE) { + txt_ok() + } + # Viridans group streptococci ---- + rule <- 'Viridans group streptococci' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + viridans_group <- c("anginosus", "australis", "bovis", "constellatus", "cristatus", + "equinus", "gallolyticus", "gordonii", "infantarius", "infantis", + "intermedius", "mitis", "mutans", "oligofermentans", "oralis", + "parasanguinis", "peroris", "pseudopneumoniae", "salivarius", + "sanguinis", "sinensis", "sobrinus", "thermophilus", "vestibularis") + if (!is.na(ampi)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Streptococcus" & tbl$species %in% viridans_group + & tbl[, ampi] == 'S'), + cols = c(ampi, amox, amcl, pita)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Streptococcus" & tbl$species %in% viridans_group + & tbl[, ampi] == 'I'), + cols = c(ampi, amox, amcl, pita)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$genus == "Streptococcus" & tbl$species %in% viridans_group + & tbl[, ampi] == 'R'), + cols = c(ampi, amox, amcl, pita)) + } + if (info == TRUE) { + txt_ok() + } + # Haemophilus influenzae ---- + rule <- 'Haemophilus influenzae' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(ampi)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, ampi] == 'S'), + cols = c(amox, pita)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, ampi] == 'I'), + cols = c(amox, pita)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, ampi] == 'R'), + cols = c(amox, pita)) + } + if (!is.na(amcl)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, amcl] == 'S'), + cols = pita) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, amcl] == 'I'), + cols = pita) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, amcl] == 'R'), + cols = pita) + } + if (!is.na(nali)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, nali] == 'S'), + cols = c(cipr, levo, moxi, oflo)) + } + if (!is.na(tetr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Haemophilus influenzae" + & tbl[, tetr] == 'S'), + cols = c(doxy, mino)) + } + if (info == TRUE) { + txt_ok() + } + # Moraxella catarrhalis ---- + rule <- 'Moraxella catarrhalis' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(amcl)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, amcl] == 'S'), + cols = pita) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, amcl] == 'I'), + cols = pita) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, amcl] == 'R'), + cols = pita) + } + if (!is.na(nali)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, nali] == 'S'), + cols = c(cipr, levo, moxi, oflo)) + } + if (!is.na(eryt)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, eryt] == 'S'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, eryt] == 'I'), + cols = c(azit, clar, roxi)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, eryt] == 'R'), + cols = c(azit, clar, roxi)) + } + if (!is.na(tetr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Moraxella catarrhalis" + & tbl[, tetr] == 'S'), + cols = c(doxy, mino)) + } + if (info == TRUE) { + txt_ok() + } + # Anaerobic Gram positives ---- + rule <- 'Anaerobic Gram positives' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which((tbl$genus %in% c("Clostridium", "Actinomyces", "Propionibacterium", + "Bifidobacterium", "Eggerthella", "Eubacterium", + "Lactobacillus ", "Actinomyces") + | tbl$fullname %like% "^Propionibacterium acnes") + & tbl[, peni] == 'S'), + cols = c(ampi, amox, pita, tica)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which((tbl$genus %in% c("Clostridium", "Actinomyces", "Propionibacterium", + "Bifidobacterium", "Eggerthella", "Eubacterium", + "Lactobacillus ", "Actinomyces") + | tbl$fullname %like% "^Propionibacterium acnes") + & tbl[, peni] == 'I'), + cols = c(ampi, amox, pita, tica)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which((tbl$genus %in% c("Clostridium", "Actinomyces", "Propionibacterium", + "Bifidobacterium", "Eggerthella", "Eubacterium", + "Lactobacillus ", "Actinomyces") + | tbl$fullname %like% "^Propionibacterium acnes") + & tbl[, peni] == 'R'), + cols = c(ampi, amox, pita, tica)) + } + if (info == TRUE) { + txt_ok() + } + # Anaerobic Gram negatives ---- + rule <- 'Anaerobic Gram negatives' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$genus %in% c("Bacteroides", "Prevotella", "Porphyromonas", + "Fusobacterium", "Bilophila ", "Mobiluncus") + & tbl[, peni] == 'S'), + cols = c(ampi, amox, pita, tica)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$genus %in% c("Bacteroides", "Prevotella", "Porphyromonas", + "Fusobacterium", "Bilophila ", "Mobiluncus") + & tbl[, peni] == 'I'), + cols = c(ampi, amox, pita, tica)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$genus %in% c("Bacteroides", "Prevotella", "Porphyromonas", + "Fusobacterium", "Bilophila ", "Mobiluncus") + & tbl[, peni] == 'R'), + cols = c(ampi, amox, pita, tica)) + } + if (info == TRUE) { + txt_ok() + } + # Pasteurella multocida ---- + rule <- 'Pasteurella multocida' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Pasteurella multocida" + & tbl[, peni] == 'S'), + cols = c(ampi, amox)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Pasteurella multocida" + & tbl[, peni] == 'I'), + cols = c(ampi, amox)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Pasteurella multocida" + & tbl[, peni] == 'R'), + cols = c(ampi, amox)) + } + if (info == TRUE) { + txt_ok() + } + # Campylobacter jejuni ---- + rule <- 'Campylobacter jejuni' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(eryt)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Campylobacter jejuni" + & tbl[, eryt] == 'S'), + cols = c(azit, clar)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Campylobacter jejuni" + & tbl[, eryt] == 'I'), + cols = c(azit, clar)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Campylobacter jejuni" + & tbl[, eryt] == 'R'), + cols = c(azit, clar)) + } + if (!is.na(tetr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Campylobacter jejuni" + & tbl[, tetr] == 'S'), + cols = doxy) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Campylobacter jejuni" + & tbl[, tetr] == 'I'), + cols = doxy) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Campylobacter jejuni" + & tbl[, tetr] == 'R'), + cols = doxy) + } + if (info == TRUE) { + txt_ok() + } + # Aerococcus sanguinicola/urinae ---- + rule <- 'Aerococcus sanguinicola/urinae' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(cipr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Aerococcus (sanguinicola|urinae)" + & tbl[, cipr] == 'S'), + cols = levo) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Aerococcus (sanguinicola|urinae)" + & tbl[, cipr] == 'I'), + cols = levo) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Aerococcus (sanguinicola|urinae)" + & tbl[, cipr] == 'R'), + cols = levo) + } + if (info == TRUE) { + txt_ok() + } + # Kingella kingae ---- + rule <- 'Kingella kingae' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } + if (!is.na(peni)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, peni] == 'S'), + cols = c(ampi, amox)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, peni] == 'I'), + cols = c(ampi, amox)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, peni] == 'R'), + cols = c(ampi, amox)) + } + if (!is.na(eryt)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, eryt] == 'S'), + cols = c(azit, clar)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, eryt] == 'I'), + cols = c(azit, clar)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, eryt] == 'R'), + cols = c(azit, clar)) + } + if (!is.na(tetr)) { + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, tetr] == 'S'), + cols = doxy) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, tetr] == 'I'), + cols = doxy) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% "^Kingella kingae" + & tbl[, tetr] == 'R'), + cols = doxy) + } + if (info == TRUE) { + txt_ok() + } + + # EXPERT RULES AND INTRINSIC RESISTANCE ----------------------------------- + + if (info == TRUE) { + cat(bold(paste0('\nEUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes (v', EUCAST_VERSION_EXPERT_RULES, ')\n'))) + } + rule_group <- "Expert Rules" + # Table 1: Intrinsic resistance in Enterobacteriaceae ---- + rule <- 'Table 1: Intrinsic resistance in Enterobacteriaceae' if (info == TRUE) { - cat('- Table 1: Intrinsic resistance in Enterobacteriaceae\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } - # Intrisiek R for this group + # Intrinsic R for this group edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$family == 'Enterobacteriaceae'), cols = c(peni, glycopeptides, fusi, macrolides, linc, streptogramins, rifa, dapt, line)) # Citrobacter edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium)'), cols = c(aminopenicillins, tica)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae)'), cols = c(aminopenicillins, amcl, czol, cfox)) # Enterobacter edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Enterobacter cloacae'), cols = c(aminopenicillins, amcl, czol, cfox)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Enterobacter aerogenes'), cols = c(aminopenicillins, amcl, czol, cfox)) # Escherichia edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Escherichia hermanni'), cols = c(aminopenicillins, tica)) # Hafnia edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Hafnia alvei'), cols = c(aminopenicillins, amcl, czol, cfox)) # Klebsiella edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Klebsiella'), cols = c(aminopenicillins, tica)) # Morganella / Proteus edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Morganella morganii'), cols = c(aminopenicillins, amcl, czol, tetracyclines, polymyxins, nitr)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Proteus mirabilis'), cols = c(tetracyclines, tige, polymyxins, nitr)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Proteus penneri'), cols = c(aminopenicillins, czol, cfur, tetracyclines, tige, polymyxins, nitr)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Proteus vulgaris'), cols = c(aminopenicillins, czol, cfur, tetracyclines, tige, polymyxins, nitr)) # Providencia edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Providencia rettgeri'), cols = c(aminopenicillins, amcl, czol, cfur, tetracyclines, tige, polymyxins, nitr)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Providencia stuartii'), cols = c(aminopenicillins, amcl, czol, cfur, tetracyclines, tige, polymyxins, nitr)) # Raoultella edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Raoultella'), cols = c(aminopenicillins, tica)) # Serratia edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Serratia marcescens'), - cols = c(aminopenicillins, amcl, czol, cfox, cfur, tetracyclines[tetracyclines != 'mino'], polymyxins, nitr)) + cols = c(aminopenicillins, amcl, czol, cfox, cfur, tetracyclines[tetracyclines != na.rm(mino)], polymyxins, nitr)) # Yersinia edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Yersinia enterocolitica'), cols = c(aminopenicillins, amcl, tica, czol, cfox)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Yersinia pseudotuberculosis'), cols = c(poly, coli)) - + if (info == TRUE) { + txt_ok() + } # Table 2: Intrinsic resistance in non-fermentative Gram-negative bacteria ---- + rule <- 'Table 2: Intrinsic resistance in non-fermentative Gram-negative bacteria' if (info == TRUE) { - cat('- Table 2: Intrinsic resistance in non-fermentative Gram-negative bacteria\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } - # Intrisiek R for this group + # Intrinsic R for this group edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus %in% c('Achromobacter', 'Acinetobacter', 'Alcaligenes', @@ -400,41 +1192,54 @@ EUCAST_rules <- function(tbl, cols = c(peni, cfox, cfur, glycopeptides, fusi, macrolides, linc, streptogramins, rifa, dapt, line)) # Acinetobacter edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Acinetobacter (baumannii|pittii|nosocomialis|calcoaceticus)'), - cols = c(aminopenicillins, amcl, czol, cfot, cftr, aztr, erta, trim, fosf, tetracyclines[tetracyclines != 'mino'])) + cols = c(aminopenicillins, amcl, czol, cfot, cftr, aztr, erta, trim, fosf, tetracyclines[tetracyclines != na.rm(mino)])) # Achromobacter edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Achromobacter (xylosoxydans|xylosoxidans)'), cols = c(aminopenicillins, czol, cfot, cftr, erta)) # Burkholderia edit_rsi(to = 'R', + rule = c(rule_group, rule), # onder 'Burkholderia cepacia complex' vallen deze species allemaal: PMID 16217180. rows = which(tbl$fullname %like% '^Burkholderia (cepacia|multivorans|cenocepacia|stabilis|vietnamiensis|dolosa|ambifaria|anthina|pyrrocinia|ubonensis)'), cols = c(aminopenicillins, amcl, tica, pita, czol, cfot, cftr, aztr, erta, cipr, chlo, aminoglycosides, trim, fosf, polymyxins)) # Elizabethkingia edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Elizabethkingia meningoseptic(a|um)'), cols = c(aminopenicillins, amcl, tica, czol, cfot, cftr, cfta, cfep, aztr, erta, imip, mero, polymyxins)) # Ochrobactrum edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Ochrobactrum anthropi'), cols = c(aminopenicillins, amcl, tica, pita, czol, cfot, cftr, cfta, cfep, aztr, erta)) # Pseudomonas edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Pseudomonas aeruginosa'), cols = c(aminopenicillins, amcl, czol, cfot, cftr, erta, chlo, kana, neom, trim, trsu, tetracyclines, tige)) # Stenotrophomonas edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Stenotrophomonas maltophilia'), cols = c(aminopenicillins, amcl, tica, pita, czol, cfot, cftr, cfta, aztr, erta, imip, mero, aminoglycosides, trim, fosf, tetr)) - + if (info == TRUE) { + txt_ok() + } # Table 3: Intrinsic resistance in other Gram-negative bacteria ---- + rule <- 'Table 3: Intrinsic resistance in other Gram-negative bacteria' if (info == TRUE) { - cat('- Table 3: Intrinsic resistance in other Gram-negative bacteria\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } - # Intrisiek R for this group + # Intrinsic R for this group edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus %in% c('Haemophilus', 'Moraxella', 'Neisseria', @@ -442,151 +1247,218 @@ EUCAST_rules <- function(tbl, cols = c(glycopeptides, linc, dapt, line)) # Haemophilus edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Haemophilus influenzae'), cols = c(fusi, streptogramins)) # Moraxella edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Moraxella catarrhalis'), cols = trim) # Neisseria edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Neisseria'), cols = trim) # Campylobacter edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Campylobacter fetus'), cols = c(fusi, streptogramins, trim, nali)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Campylobacter (jejuni|coli)'), cols = c(fusi, streptogramins, trim)) - + if (info == TRUE) { + txt_ok() + } # Table 4: Intrinsic resistance in Gram-positive bacteria ---- + rule <- 'Table 4: Intrinsic resistance in Gram-positive bacteria' if (info == TRUE) { - cat('- Table 4: Intrinsic resistance in Gram-positive bacteria\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } - # Intrisiek R for this group + # Intrinsic R for this group edit_rsi(to = 'R', - rows = which(tbl$gramstain %like% 'Positi(e|)(v|f)'), + rule = c(rule_group, rule), + rows = which(tbl$gramstain == "Gram positive"), cols = c(aztr, polymyxins, nali)) # Staphylococcus edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Staphylococcus saprophyticus'), cols = c(fusi, cfta, fosf, novo)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Staphylococcus (cohnii|xylosus)'), cols = c(cfta, novo)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Staphylococcus capitis'), cols = c(cfta, fosf)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)'), cols = cfta) # Streptococcus + # rule 4.5 edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Streptococcus'), - cols = c(fusi, cfta, aminoglycosides)) + cols = c(fusi, aminoglycosides)) # Enterococcus edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Enterococcus faecalis'), - cols = c(fusi, cfta, cephalosporins[cephalosporins != cfta], aminoglycosides, macrolides, clin, qida, trim, trsu)) + cols = c(fusi, cfta, cephalosporins[cephalosporins != na.rm(cfta)], aminoglycosides, macrolides, clin, qida, trim, trsu)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Enterococcus (gallinarum|casseliflavus)'), - cols = c(fusi, cfta, cephalosporins[cephalosporins != cfta], aminoglycosides, macrolides, clin, qida, vanc, trim, trsu)) + cols = c(fusi, cfta, cephalosporins[cephalosporins != na.rm(cfta)], aminoglycosides, macrolides, clin, qida, vanc, trim, trsu)) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Enterococcus faecium'), - cols = c(fusi, cfta, cephalosporins[cephalosporins != cfta], aminoglycosides, macrolides, trim, trsu)) + cols = c(fusi, cfta, cephalosporins[cephalosporins != na.rm(cfta)], aminoglycosides, macrolides, trim, trsu)) # Corynebacterium edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Corynebacterium'), cols = fosf) # Listeria edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Listeria monocytogenes'), - cols = c(cfta, cephalosporins[cephalosporins != cfta])) - # overig + cols = c(cfta, cephalosporins[cephalosporins != na.rm(cfta)])) + # other edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus %in% c('Leuconostoc', 'Pediococcus')), cols = glycopeptides) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Lactobacillus'), cols = glycopeptides) edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Clostridium (ramosum|innocuum)'), cols = vanc) + if (info == TRUE) { + txt_ok() + } # Table 8: Interpretive rules for B-lactam agents and Gram-positive cocci ---- + rule <- 'Table 8: Interpretive rules for B-lactam agents and Gram-positive cocci' if (info == TRUE) { - cat('- Table 8: Interpretive rules for B-lactam agents and Gram-positive cocci\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } # rule 8.3 if (!is.na(peni)) { edit_rsi(to = 'S', - rows = which(tbl$fullname %like% '^Streptococcus (pyogenes|agalactiae|dysgalactiae|groep A|groep B|groep C|groep G)' + rule = c(rule_group, rule), + rows = which(tbl$fullname %like% '^Streptococcus (pyogenes|agalactiae|dysgalactiae|group A|group B|group C|group G)' & tbl[, peni] == 'S'), cols = c(aminopenicillins, cephalosporins, carbapenems)) } # rule 8.6 if (!is.na(ampi)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Enterococcus' & tbl[, ampi] == 'R'), cols = c(ureidopenicillins, carbapenems)) } if (!is.na(amox)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Enterococcus' & tbl[, amox] == 'R'), cols = c(ureidopenicillins, carbapenems)) } + if (info == TRUE) { + txt_ok() + } # Table 9: Interpretive rules for B-lactam agents and Gram-negative rods ---- + rule <- 'Table 9: Interpretive rules for B-lactam agents and Gram-negative rods' if (info == TRUE) { - cat('- Table 9: Interpretive rules for B-lactam agents and Gram-negative rods\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } # rule 9.3 if (!is.na(tica) & !is.na(pita)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$family == 'Enterobacteriaceae' & tbl[, tica] == 'R' & tbl[, pita] == 'S'), cols = pita) } + if (info == TRUE) { + txt_ok() + } # Table 10: Interpretive rules for B-lactam agents and other Gram-negative bacteria ---- + rule <- 'Table 10: Interpretive rules for B-lactam agents and other Gram-negative bacteria' if (info == TRUE) { - cat('- Table 10: Interpretive rules for B-lactam agents and other Gram-negative bacteria\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } # rule 10.2 - if (!is.na(ampi)) { - # you should know first if the are B-lactamase positive, so do not run for now - # edit_rsi(to = 'R', - # rows = which(tbl$fullname %like% '^Haemophilus influenza' - # & tbl[, ampi] == 'R'), - # cols = c(ampi, amox, amcl, pita, cfur)) + # if (!is.na(ampi)) { + # you should know first if the are B-lactamase positive, so do not run for now + # edit_rsi(to = 'R', + # rule = c(rule_group, rule), + # rows = which(tbl$fullname %like% '^Haemophilus influenza' + # & tbl[, ampi] == 'R'), + # cols = c(ampi, amox, amcl, pita, cfur)) + # } + if (info == TRUE) { + txt_ok() } # Table 11: Interpretive rules for macrolides, lincosamides, and streptogramins ---- + rule <- 'Table 11: Interpretive rules for macrolides, lincosamides, and streptogramins' if (info == TRUE) { - cat('- Table 11: Interpretive rules for macrolides, lincosamides, and streptogramins\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } # rule 11.1 if (!is.na(eryt)) { - if (!is.na(azit)) { - tbl[, azit] <- tbl[, eryt] - } - if (!is.na(clar)) { - tbl[, clar] <- tbl[, eryt] - } + edit_rsi(to = 'S', + rule = c(rule_group, rule), + rows = which(tbl[, eryt] == 'S'), + cols = c(azit, clar)) + edit_rsi(to = 'I', + rule = c(rule_group, rule), + rows = which(tbl[, eryt] == 'I'), + cols = c(azit, clar)) + edit_rsi(to = 'R', + rule = c(rule_group, rule), + rows = which(tbl[, eryt] == 'R'), + cols = c(azit, clar)) + } + if (info == TRUE) { + txt_ok() } # Table 12: Interpretive rules for aminoglycosides ---- + rule <- 'Table 12: Interpretive rules for aminoglycosides' if (info == TRUE) { - cat('- Table 12: Interpretive rules for aminoglycosides\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } # rule 12.2 if (!is.na(tobr)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Staphylococcus' & tbl[, tobr] == 'R'), cols = c(kana, amik)) @@ -594,6 +1466,7 @@ EUCAST_rules <- function(tbl, # rule 12.3 if (!is.na(gent)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Staphylococcus' & tbl[, gent] == 'R'), cols = aminoglycosides) @@ -601,6 +1474,7 @@ EUCAST_rules <- function(tbl, # rule 12.8 if (!is.na(gent) & !is.na(tobr)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$family == 'Enterobacteriaceae' & tbl[, gent] == 'I' & tbl[, tobr] == 'S'), @@ -609,20 +1483,28 @@ EUCAST_rules <- function(tbl, # rule 12.9 if (!is.na(gent) & !is.na(tobr)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$family == 'Enterobacteriaceae' & tbl[, tobr] == 'I' & tbl[, gent] == 'R'), cols = tobr) } + if (info == TRUE) { + txt_ok() + } # Table 13: Interpretive rules for quinolones ---- + rule <- 'Table 13: Interpretive rules for quinolones' if (info == TRUE) { - cat('- Table 13: Interpretive rules for quinolones\n') + warned <- FALSE + changed_results <- 0 + cat(rule) } # rule 13.2 if (!is.na(moxi)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$genus == 'Staphylococcus' & tbl[, moxi] == 'R'), cols = fluoroquinolones) @@ -630,6 +1512,7 @@ EUCAST_rules <- function(tbl, # rule 13.4 if (!is.na(moxi)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Streptococcus pneumoniae' & tbl[, moxi] == 'R'), cols = fluoroquinolones) @@ -637,6 +1520,7 @@ EUCAST_rules <- function(tbl, # rule 13.5 if (!is.na(cipr)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$family == 'Enterobacteriaceae' & tbl[, cipr] == 'R'), cols = fluoroquinolones) @@ -644,63 +1528,101 @@ EUCAST_rules <- function(tbl, # rule 13.8 if (!is.na(cipr)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl$fullname %like% '^Neisseria gonorrhoeae' & tbl[, cipr] == 'R'), cols = fluoroquinolones) } - - - # Other ---- if (info == TRUE) { - cat('- Non-EUCAST: trim = R where trsu = R and ampi = R where amcl = R\n') + txt_ok() + } + + # OTHER RULES ------------------------------------------------------------- + + if (info == TRUE) { + cat(bold('\nOther rules\n')) + } + rule_group <- "Other rules" + + rule <- 'Non-EUCAST: ampicillin = R where amoxicillin/clav acid = R' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) } if (!is.na(amcl)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl[, amcl] == 'R'), cols = ampi) } + if (info == TRUE) { + txt_ok() + } + rule <- 'Non-EUCAST: trimethoprim = R where trimethoprim/sulfa = R' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } if (!is.na(trsu)) { edit_rsi(to = 'R', + rule = c(rule_group, rule), rows = which(tbl[, trsu] == 'R'), cols = trim) } if (info == TRUE) { - cat('- Non-EUCAST: trsu = S where trim = S and amcl = S where ampi = S\n') + txt_ok() + } + rule <- 'Non-EUCAST: amoxicillin/clav acid = S where ampicillin = S' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) } if (!is.na(amcl)) { edit_rsi(to = 'S', + rule = c(rule_group, rule), rows = which(tbl[, ampi] == 'S'), cols = amcl) } + if (info == TRUE) { + txt_ok() + } + rule <- 'Non-EUCAST: trimethoprim/sulfa = S where trimethoprim = S' + if (info == TRUE) { + warned <- FALSE + changed_results <- 0 + cat(rule) + } if (!is.na(trsu)) { edit_rsi(to = 'S', + rule = c(rule_group, rule), rows = which(tbl[, trim] == 'S'), cols = trsu) } - # amox = ampi - if (!is.na(ampi) & !is.na(amox)) { - tbl[, amox] <- tbl %>% pull(ampi) + if (info == TRUE) { + txt_ok() } - # Remove added columns again - microorganisms.ncol <- ncol(AMR::microorganisms) - 2 - tbl.ncol <- ncol(tbl) - tbl <- tbl %>% select(-c((tbl.ncol - microorganisms.ncol):tbl.ncol)) - # and remove added suffices - colnames(tbl) <- gsub("_tempmicroorganisms", "", colnames(tbl)) # restore old col_mo values if needed if (!is.null(col_mo_original)) { - tbl[, col_mo] <- col_mo_original + tbl_original[, col_mo] <- col_mo_original } if (info == TRUE) { - cat('Done.\n\nEUCAST Expert rules applied to', - total_rows %>% unique() %>% length() %>% format(big.mark = ","), - 'different rows; overwritten a total of', - total %>% format(big.mark = ","), 'test results.\n\n') + cat(bold('\n=> EUCAST rules affected', + amount_affected_rows %>% length() %>% format(big.mark = ","), + 'out of', nrow(tbl_original) %>% format(big.mark = ","), + 'rows -- changed', + amount_changed %>% format(big.mark = ","), 'test results.\n\n')) } - tbl + if (verbose_info != "") { + message("Verbose information:", verbose_info) + } + + tbl_original } #' @rdname EUCAST diff --git a/R/mic.R b/R/mic.R index 25bbeb78..594262e0 100755 --- a/R/mic.R +++ b/R/mic.R @@ -22,7 +22,7 @@ #' @rdname as.mic #' @param x vector #' @param na.rm a logical indicating whether missing values should be removed -#' @return Ordered factor with new class \code{mic} and new attribute \code{package} +#' @return Ordered factor with new class \code{mic} #' @keywords mic #' @export #' @importFrom dplyr %>% @@ -148,11 +148,8 @@ as.mic <- function(x, na.rm = FALSE) { list_missing, call. = FALSE) } - x <- factor(x = x, - levels = lvls, - ordered = TRUE) + x <- factor(x, levels = lvls, ordered = TRUE) class(x) <- c('mic', 'ordered', 'factor') - attr(x, 'package') <- 'AMR' x } } diff --git a/R/rsi.R b/R/rsi.R index 19017a85..efb76031 100644 --- a/R/rsi.R +++ b/R/rsi.R @@ -22,7 +22,7 @@ #' @rdname as.rsi #' @param x vector #' @details The function \code{is.rsi.eligible} returns \code{TRUE} when a columns contains only valid antimicrobial interpretations (S and/or I and/or R), and \code{FALSE} otherwise. -#' @return Ordered factor with new class \code{rsi} and new attribute \code{package} +#' @return Ordered factor with new class \code{rsi} #' @keywords rsi #' @export #' @importFrom dplyr %>% @@ -81,9 +81,8 @@ as.rsi <- function(x) { list_missing, call. = FALSE) } - x <- x %>% factor(levels = c("S", "I", "R"), ordered = TRUE) + x <- factor(x, levels = c("S", "I", "R"), ordered = TRUE) class(x) <- c('rsi', 'ordered', 'factor') - attr(x, 'package') <- 'AMR' x } } diff --git a/README.md b/README.md index 597ff566..933fb3ce 100755 --- a/README.md +++ b/README.md @@ -202,7 +202,7 @@ Adjust it with any parameter you know from the `ggplot2` package: septic_patients %>% select(amox, nitr, fosf, trim, cipr) %>% ggplot_rsi(datalabels = FALSE, - width = 0.5, colour = "black", size = 1, linetype = 2, alpha = 0.25) + width = 0.5, colour = "purple", size = 1, linetype = 2, alpha = 0.5) ``` ![example_3_rsi](man/figures/rsi_example3.png) @@ -225,6 +225,41 @@ septic_patients %>% You could use this to group on anything in your plots: Gram stain, age (group), genus, geographic location, et cetera. +Is there a significant difference between hospital A and D when it comes to Fosfomycin? +```r +check_A_and_D <- septic_patients %>% + filter(hospital_id %in% c("A", "D")) %>% # filter on only hospitals A and D + select(hospital_id, fosf) %>% # select the hospitals and fosfomycin + group_by(hospital_id) %>% + count_df(combine_IR = TRUE) %>% # count all isolates per group (hospital_id) + tidyr::spread(hospital_id, Value) %>% # transform output so A and D are columns + select(A, D) %>% # and select these only + as.matrix() # transform to good old matrix for fisher.test + +check_A_and_D +# A D +# [1,] 24 33 +# [2,] 25 77 +``` + +Total sum is lower than 1,000 so we'd prefer a [Fisher's exact test](https://en.wikipedia.org/wiki/Fisher%27s_exact_test), not a [*G*-test](https://en.wikipedia.org/wiki/G-test) (or its formerly used equivalent, the famous [Chi2 test](https://en.wikipedia.org/wiki/Chi-squared_test)): +``` +fisher.test(check_A_and_D) +# +# Fisher's Exact Test for Count Data +# +# data: . +# p-value = 0.03104 +# alternative hypothesis: true odds ratio is not equal to 1 +# 95 percent confidence interval: +# 1.054283 4.735995 +# sample estimates: +# odds ratio +# 2.228006 +``` + +Well, there you go! + #### MIC ```r diff --git a/data/septic_patients.rda b/data/septic_patients.rda index c39cdaea..10975011 100755 Binary files a/data/septic_patients.rda and b/data/septic_patients.rda differ diff --git a/man/EUCAST.Rd b/man/EUCAST.Rd index f2d752f6..6fc83ff0 100755 --- a/man/EUCAST.Rd +++ b/man/EUCAST.Rd @@ -3,14 +3,23 @@ \name{EUCAST_rules} \alias{EUCAST_rules} \alias{interpretive_reading} -\title{EUCAST expert rules} +\title{EUCAST rules} \source{ -EUCAST Expert Rules Version 2.0: \cr - Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility testing.} \emph{Clin Microbiol Infect.} 2013;19(2):141-60. \cr - \url{https://doi.org/10.1111/j.1469-0691.2011.03703.x} \cr - \cr - EUCAST Expert Rules Version 3.1 (Intrinsic Resistance and Exceptional Phenotypes Tables): \cr - \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf} +\itemize{ + \item{ + EUCAST Expert Rules. Version 2.0, 2012. \cr + Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility testing.} \emph{Clin Microbiol Infect.} 2013;19(2):141-60. \cr + \url{https://doi.org/10.1111/j.1469-0691.2011.03703.x} + } + \item{ + EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. \cr + \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf} + } + \item{ + EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 8.1, 2018. \cr + \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_8.1_Breakpoint_Tables.xlsx} + } + } } \usage{ EUCAST_rules(tbl, col_mo = "mo", info = TRUE, amcl = "amcl", @@ -25,11 +34,11 @@ EUCAST_rules(tbl, col_mo = "mo", info = TRUE, amcl = "amcl", line = "line", mero = "mero", mezl = "mezl", mino = "mino", moxi = "moxi", nali = "nali", neom = "neom", neti = "neti", nitr = "nitr", norf = "norf", novo = "novo", oflo = "oflo", - peni = "peni", pita = "pita", poly = "poly", pris = "pris", - qida = "qida", rifa = "rifa", roxi = "roxi", siso = "siso", - teic = "teic", tetr = "tetr", tica = "tica", tige = "tige", - tobr = "tobr", trim = "trim", trsu = "trsu", vanc = "vanc", - col_bactid = "bactid") + oxac = "oxac", peni = "peni", pita = "pita", poly = "poly", + pris = "pris", qida = "qida", rifa = "rifa", roxi = "roxi", + siso = "siso", teic = "teic", tetr = "tetr", tica = "tica", + tige = "tige", tobr = "tobr", trim = "trim", trsu = "trsu", + vanc = "vanc", col_bactid = "bactid", verbose = FALSE) interpretive_reading(...) } @@ -40,23 +49,25 @@ interpretive_reading(...) \item{info}{print progress} -\item{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, peni, pita, poly, pris, qida, rifa, roxi, siso, teic, tetr, tica, tige, tobr, trim, trsu, vanc}{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.} +\item{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, pita, poly, pris, qida, rifa, roxi, siso, teic, tetr, tica, tige, tobr, trim, trsu, vanc}{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.} \item{col_bactid}{Deprecated. Use \code{col_mo} instead.} +\item{verbose}{a logical to indicate whether extensive info should be printed to the console about which rows and columns are effected with their old and new values} + \item{...}{parameters that are passed on to \code{EUCAST_rules}} } \value{ table with edited variables of antibiotics. } \description{ -Apply expert rules (like intrinsic resistance), as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}. +Apply susceptibility rules as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}. This includes (1) expert rules, (2) intrinsic resistance and (3) inferred resistance as defined in their breakpoint tables. } \section{Antibiotics}{ Abbrevations of the column containing antibiotics: - \strong{amcl}: amoxicillin and beta-lactamase inhibitor (\emph{J01CR02}), + \strong{amcl}: amoxicillin+clavulanic acid (\emph{J01CR02}), \strong{amik}: amikacin (\emph{J01GB06}), \strong{amox}: amoxicillin (\emph{J01CA04}), \strong{ampi}: ampicillin (\emph{J01CA01}), @@ -85,7 +96,7 @@ Abbrevations of the column containing antibiotics: \strong{fosf}: fosfomycin (\emph{J01XX01}), \strong{fusi}: fusidic acid (\emph{J01XC01}), \strong{gent}: gentamicin (\emph{J01GB03}), - \strong{imip}: imipenem and cilastatin (\emph{J01DH51}), + \strong{imip}: imipenem (\emph{J01DH51}), \strong{kana}: kanamycin (\emph{J01GB04}), \strong{levo}: levofloxacin (\emph{J01MA12}), \strong{linc}: lincomycin (\emph{J01FF02}), @@ -101,8 +112,8 @@ Abbrevations of the column containing antibiotics: \strong{norf}: norfloxacin (\emph{J01MA06}), \strong{novo}: novobiocin (an ATCvet code: \emph{QJ01XX95}), \strong{oflo}: ofloxacin (\emph{J01MA01}), - \strong{peni}: penicillins, combinations with other antibacterials (\emph{J01RA01}), - \strong{pita}: piperacillin and beta-lactamase inhibitor (\emph{J01CR05}), + \strong{peni}: penicillin (\emph{J01RA01}), + \strong{pita}: piperacillin+tazobactam (\emph{J01CR05}), \strong{poly}: polymyxin B (\emph{J01XB02}), \strong{pris}: pristinamycin (\emph{J01FG01}), \strong{qida}: quinupristin/dalfopristin (\emph{J01FG02}), diff --git a/man/MDRO.Rd b/man/MDRO.Rd index 9d8a63f6..7df3ac7c 100755 --- a/man/MDRO.Rd +++ b/man/MDRO.Rd @@ -175,7 +175,7 @@ When \code{country} will be left blank, guidelines will be taken from EUCAST Exp Abbrevations of the column containing antibiotics: - \strong{amcl}: amoxicillin and beta-lactamase inhibitor (\emph{J01CR02}), + \strong{amcl}: amoxicillin+clavulanic acid (\emph{J01CR02}), \strong{amik}: amikacin (\emph{J01GB06}), \strong{amox}: amoxicillin (\emph{J01CA04}), \strong{ampi}: ampicillin (\emph{J01CA01}), @@ -204,7 +204,7 @@ Abbrevations of the column containing antibiotics: \strong{fosf}: fosfomycin (\emph{J01XX01}), \strong{fusi}: fusidic acid (\emph{J01XC01}), \strong{gent}: gentamicin (\emph{J01GB03}), - \strong{imip}: imipenem and cilastatin (\emph{J01DH51}), + \strong{imip}: imipenem (\emph{J01DH51}), \strong{kana}: kanamycin (\emph{J01GB04}), \strong{levo}: levofloxacin (\emph{J01MA12}), \strong{linc}: lincomycin (\emph{J01FF02}), @@ -220,8 +220,8 @@ Abbrevations of the column containing antibiotics: \strong{norf}: norfloxacin (\emph{J01MA06}), \strong{novo}: novobiocin (an ATCvet code: \emph{QJ01XX95}), \strong{oflo}: ofloxacin (\emph{J01MA01}), - \strong{peni}: penicillins, combinations with other antibacterials (\emph{J01RA01}), - \strong{pita}: piperacillin and beta-lactamase inhibitor (\emph{J01CR05}), + \strong{peni}: penicillin (\emph{J01RA01}), + \strong{pita}: piperacillin+tazobactam (\emph{J01CR05}), \strong{poly}: polymyxin B (\emph{J01XB02}), \strong{pris}: pristinamycin (\emph{J01FG01}), \strong{qida}: quinupristin/dalfopristin (\emph{J01FG02}), diff --git a/man/as.mic.Rd b/man/as.mic.Rd index 02e0ef53..3a178ade 100755 --- a/man/as.mic.Rd +++ b/man/as.mic.Rd @@ -15,7 +15,7 @@ is.mic(x) \item{na.rm}{a logical indicating whether missing values should be removed} } \value{ -Ordered factor with new class \code{mic} and new attribute \code{package} +Ordered factor with new class \code{mic} } \description{ This transforms a vector to a new class \code{mic}, which is an ordered factor with valid MIC values as levels. Invalid MIC values will be translated as \code{NA} with a warning. diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index 92a97c24..4e6ff224 100755 --- a/man/as.rsi.Rd +++ b/man/as.rsi.Rd @@ -16,7 +16,7 @@ is.rsi.eligible(x) \item{x}{vector} } \value{ -Ordered factor with new class \code{rsi} and new attribute \code{package} +Ordered factor with new class \code{rsi} } \description{ This transforms a vector to a new class \code{rsi}, which is an ordered factor with levels \code{S < I < R}. Invalid antimicrobial interpretations will be translated as \code{NA} with a warning. diff --git a/man/figures/rsi_example2.png b/man/figures/rsi_example2.png index 399a8b48..392d75b8 100644 Binary files a/man/figures/rsi_example2.png and b/man/figures/rsi_example2.png differ diff --git a/man/figures/rsi_example3.png b/man/figures/rsi_example3.png index 2ec9c87c..267a5b0f 100644 Binary files a/man/figures/rsi_example3.png and b/man/figures/rsi_example3.png differ diff --git a/man/figures/rsi_example4.png b/man/figures/rsi_example4.png index fe28be02..eb8b0e13 100644 Binary files a/man/figures/rsi_example4.png and b/man/figures/rsi_example4.png differ diff --git a/man/septic_patients.Rd b/man/septic_patients.Rd index d63b449d..f6921198 100755 --- a/man/septic_patients.Rd +++ b/man/septic_patients.Rd @@ -4,7 +4,7 @@ \name{septic_patients} \alias{septic_patients} \title{Data set with 2000 blood culture isolates of septic patients} -\format{A \code{\link{tibble}} with 2,000 observations and 49 variables: +\format{A \code{\link{data.frame}} with 2,000 observations and 49 variables: \describe{ \item{\code{date}}{date of receipt at the laboratory} \item{\code{hospital_id}}{ID of the hospital, from A to D} diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index 779fc4b8..ae089e3b 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -2,18 +2,18 @@ context("count.R") test_that("counts work", { # amox resistance in `septic_patients` - expect_equal(count_R(septic_patients$amox), 662) + expect_equal(count_R(septic_patients$amox), 683) expect_equal(count_I(septic_patients$amox), 3) - expect_equal(count_S(septic_patients$amox), 335) + expect_equal(count_S(septic_patients$amox), 486) expect_equal(count_R(septic_patients$amox) + count_I(septic_patients$amox), count_IR(septic_patients$amox)) expect_equal(count_S(septic_patients$amox) + count_I(septic_patients$amox), count_SI(septic_patients$amox)) library(dplyr) - expect_equal(septic_patients %>% count_S(amcl), 1057) - expect_equal(septic_patients %>% count_S(amcl, gent), 1396) - expect_equal(septic_patients %>% count_all(amcl, gent), 1517) + expect_equal(septic_patients %>% count_S(amcl), 1291) + expect_equal(septic_patients %>% count_S(amcl, gent), 1609) + expect_equal(septic_patients %>% count_all(amcl, gent), 1747) expect_identical(septic_patients %>% count_all(amcl, gent), septic_patients %>% count_S(amcl, gent) + septic_patients %>% count_IR(amcl, gent)) diff --git a/tests/testthat/test-eucast.R b/tests/testthat/test-eucast.R index 2978a093..cd05f7d1 100755 --- a/tests/testthat/test-eucast.R +++ b/tests/testthat/test-eucast.R @@ -8,30 +8,26 @@ test_that("EUCAST rules work", { expect_identical(colnames(septic_patients), colnames(suppressWarnings(EUCAST_rules(septic_patients)))) - a <- data.frame(mo = - c("KLEPNE", # Klebsiella pneumoniae - "PSEAER", # Pseudomonas aeruginosa - "ENTAER"), # Enterobacter aerogenes + a <- data.frame(mo = c("KLEPNE", # Klebsiella pneumoniae + "PSEAER", # Pseudomonas aeruginosa + "ENTAER"), # Enterobacter aerogenes amox = "-", # Amoxicillin stringsAsFactors = FALSE) - b <- data.frame(mo = - c("KLEPNE", # Klebsiella pneumoniae - "PSEAER", # Pseudomonas aeruginosa - "ENTAER"), # Enterobacter aerogenes - amox = "R", # Amoxicillin + b <- data.frame(mo = c("KLEPNE", # Klebsiella pneumoniae + "PSEAER", # Pseudomonas aeruginosa + "ENTAER"), # Enterobacter aerogenes + amox = "R", # Amoxicillin stringsAsFactors = FALSE) expect_identical(suppressWarnings(EUCAST_rules(a, info = FALSE)), b) expect_identical(suppressWarnings(interpretive_reading(a, info = TRUE)), b) - a <- data.frame(mo = - c("STAAUR", # Staphylococcus aureus - "STCGRA"), # Streptococcus pyognenes (Lancefield Group A) - coli = "-", # Colistin + a <- data.frame(mo = c("STAAUR", # Staphylococcus aureus + "STCGRA"), # Streptococcus pyognenes (Lancefield Group A) + coli = "-", # Colistin stringsAsFactors = FALSE) - b <- data.frame(mo = - c("STAAUR", # Staphylococcus aureus - "STCGRA"), # Streptococcus pyognenes (Lancefield Group A) - coli = "R", # Colistin + b <- data.frame(mo = c("STAAUR", # Staphylococcus aureus + "STCGRA"), # Streptococcus pyognenes (Lancefield Group A) + coli = "R", # Colistin stringsAsFactors = FALSE) expect_equal(suppressWarnings(EUCAST_rules(a, info = FALSE)), b) @@ -48,17 +44,35 @@ test_that("EUCAST rules work", { unique() %>% as.character()), "R") + # azit and clar must be equal to eryt - expect_equal(suppressWarnings( + a <- suppressWarnings( septic_patients %>% - mutate(azit = as.rsi("R"), - clar = as.rsi("R")) %>% + transmute(mo, + eryt, + azit = as.rsi("R"), + clar = as.rsi("R")) %>% EUCAST_rules(col_mo = "mo") %>% - pull(clar)), - suppressWarnings( - septic_patients %>% - EUCAST_rules(col_mo = "mo") %>% - left_join_microorganisms() %>% - pull(eryt))) + pull(clar)) + b <- suppressWarnings( + septic_patients %>% + select(mo, eryt) %>% + EUCAST_rules(col_mo = "mo") %>% + pull(eryt)) + + expect_identical(a[!is.na(b)], + b[!is.na(b)]) + + # amox is inferred by benzylpenicillin in Kingella kingae + expect_equal( + as.list(EUCAST_rules( + data.frame(mo = as.mo("Kingella kingae"), + peni = "S", + amox = "-", + stringsAsFactors = FALSE) + , info = FALSE))$amox, + "S") + + expect_message(suppressWarnings(EUCAST_rules(septic_patients, verbose = TRUE))) }) diff --git a/tests/testthat/test-portion.R b/tests/testthat/test-portion.R index a179e93f..8ad11ac5 100755 --- a/tests/testthat/test-portion.R +++ b/tests/testthat/test-portion.R @@ -2,8 +2,8 @@ context("portion.R") test_that("portions works", { # amox resistance in `septic_patients` - expect_equal(portion_R(septic_patients$amox), 0.662, tolerance = 0.0001) - expect_equal(portion_I(septic_patients$amox), 0.003, tolerance = 0.0001) + expect_equal(portion_R(septic_patients$amox), 0.5827645, tolerance = 0.0001) + expect_equal(portion_I(septic_patients$amox), 0.0025597, tolerance = 0.0001) expect_equal(1 - portion_R(septic_patients$amox) - portion_I(septic_patients$amox), portion_S(septic_patients$amox)) expect_equal(portion_R(septic_patients$amox) + portion_I(septic_patients$amox), @@ -12,17 +12,17 @@ test_that("portions works", { portion_SI(septic_patients$amox)) expect_equal(septic_patients %>% portion_S(amcl), - 0.6706853, + 0.7062363, tolerance = 0.001) expect_equal(septic_patients %>% portion_S(amcl, gent), - 0.9202373, + 0.9210074, tolerance = 0.001) # amcl+genta susceptibility around 92.1% expect_equal(suppressWarnings(rsi(septic_patients$amcl, septic_patients$gent, interpretation = "S")), - 0.9202373, + 0.9210074, tolerance = 0.000001) # percentages @@ -57,7 +57,7 @@ test_that("portions works", { septic_patients$gent))) expect_equal(suppressWarnings(n_rsi(as.character(septic_patients$amcl, septic_patients$gent))), - 1576) + 1828) # check for errors expect_error(portion_IR("test", minimum = "test")) @@ -83,16 +83,16 @@ test_that("portions works", { }) test_that("old rsi works", { - # amox resistance in `septic_patients` should be around 66.33% - expect_equal(suppressWarnings(rsi(septic_patients$amox)), 0.665, tolerance = 0.0001) - expect_equal(suppressWarnings(rsi(septic_patients$amox, interpretation = "S")), 1 - 0.665, tolerance = 0.0001) + # amox resistance in `septic_patients` should be around 58.53% + expect_equal(suppressWarnings(rsi(septic_patients$amox)), 0.5853, tolerance = 0.0001) + expect_equal(suppressWarnings(rsi(septic_patients$amox, interpretation = "S")), 1 - 0.5853, tolerance = 0.0001) # pita+genta susceptibility around 98.09% expect_equal(suppressWarnings(rsi(septic_patients$pita, septic_patients$gent, interpretation = "S", info = TRUE)), - 0.9540412, + 0.9498886, tolerance = 0.0001) # count of cases