diff --git a/.Rbuildignore b/.Rbuildignore index 6b4a446a..722e91de 100755 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,6 +1,6 @@ ^.*\.Rproj$ -^\.gitlab-ci\.yml$ ^\.gitlab-ci\.R$ +^\.gitlab-ci\.yml$ ^\.Renviron$ ^\.Rprofile$ ^\.Rproj\.user$ @@ -9,6 +9,7 @@ ^_noinclude$ ^_pkgdown\.yml$ ^appveyor\.yml$ +^codecov\.yml$ ^cran-comments\.md$ ^CRAN-RELEASE$ ^doc$ diff --git a/R/eucast_rules.R b/R/eucast_rules.R index ee89bcbf..b7012b5a 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -35,6 +35,8 @@ EUCAST_VERSION_EXPERT_RULES <- "3.1, 2016" #' @param ... parameters that are passed on to \code{eucast_rules} #' @inheritParams first_isolate #' @details +#' \strong{NOTE:} This function does not translate MIC values to RSI values. It only applies (1) inferred susceptibility and resistance based on results of other antibiotics and (2) intrinsic resistance based on taxonomic properties of a microorganism. +#' #' The file used for applying all EUCAST rules can be retrieved with \code{\link{eucast_rules_file}()}. It returns an easily readable data set containing all rules. The original TSV file (tab separated file) that is being read by this function can be found when running this command: \cr #' \code{AMR::EUCAST_RULES_FILE_LOCATION} (without brackets). #' diff --git a/R/first_isolate.R b/R/first_isolate.R index 7993694a..5c2f1e7b 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -42,7 +42,7 @@ #' @details \strong{WHY THIS IS SO IMPORTANT} \cr #' To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode \href{https://www.ncbi.nlm.nih.gov/pubmed/17304462}{[1]}. If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all \emph{S. aureus} isolates would be overestimated, because you included this MRSA more than once. It would be \href{https://en.wikipedia.org/wiki/Selection_bias}{selection bias}. #' -#' The function \code{filter_first_isolate} is essentially equal to: +#' The functions \code{filter_first_isolate} and \code{filter_first_weighted_isolate} are helper functions to quickly filter on first isolates. The function \code{filter_first_isolate} is essentially equal to: #' \preformatted{ #' tbl \%>\% #' mutate(only_firsts = first_isolate(tbl, ...)) \%>\% @@ -62,10 +62,10 @@ #' There are two ways to determine whether isolates can be included as first \emph{weighted} isolates which will give generally the same results: \cr #' #' \strong{1. Using} \code{type = "keyantibiotics"} \strong{and parameter} \code{ignore_I} \cr -#' Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. \cr +#' Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the \code{\link{key_antibiotics}} function. \cr #' #' \strong{2. Using} \code{type = "points"} \strong{and parameter} \code{points_threshold} \cr -#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, an isolate will be (re)selected as a first weighted isolate. +#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which default to \code{2}, an isolate will be (re)selected as a first weighted isolate. #' @rdname first_isolate #' @keywords isolate isolates first #' @seealso \code{\link{key_antibiotics}} @@ -109,8 +109,8 @@ #' #' # Have a look at A and B. #' # B is more reliable because every isolate is only counted once. -#' # Gentamicin resitance in hospital D appears to be 5.4% higher than -#' # when you (erroneously) would have used all isolates! +#' # Gentamicin resitance in hospital D appears to be 3.1% higher than +#' # when you (erroneously) would have used all isolates for analysis. #' #' #' ## OTHER EXAMPLES: diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index 095ad469..92feeb1f 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -26,6 +26,7 @@ #' @param col a character to look for #' @param verbose a logical to indicate whether additional info should be printed #' @importFrom dplyr %>% select filter_all any_vars +#' @importFrom crayon blue #' @export #' @inheritSection AMR Read more on our website! #' @examples @@ -70,6 +71,9 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) { unlist() if (col %in% tbl_names) { + if (verbose == TRUE) { + message(blue(paste0("NOTE: Using column `", bold(col), "` as input for `", col, "`."))) + } return(col) } ab_result <- antibiotics %>% @@ -77,7 +81,7 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) { filter_all(any_vars(tolower(.) == tolower(col))) %>% filter_all(any_vars(. %in% tbl_names)) - if (nrow(ab_result) == 0 & nchar(col) > 4) { + if (nrow(ab_result) == 0 & nchar(col) >= 5) { # use like when col >= 5 characters ab_result <- antibiotics %>% select(atc:trade_name) %>% @@ -87,14 +91,28 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) { # WHONET if (nrow(ab_result) == 0) { - # use like when col >= 5 characters + # use like for any case ab_result <- antibiotics %>% select(atc:trade_name) %>% filter_all(any_vars(tolower(.) == tolower(col))) %>% filter_all(any_vars(. %in% tbl_names_stripped)) } - if (nrow(ab_result) > 1) { + found_based_on_official_name <- FALSE + if (nrow(ab_result) == 0) { + # check if first part of official name resembles the columns that's been looking for + name <- suppressWarnings(atc_name(col)) + if (!is.null(name)) { + ab_result <- + antibiotics %>% + filter(official == name) %>% + pull(official) + ab_result <- tbl_names[tbl_names %like% paste0("^", substr(ab_result, 1, 5))] + found_based_on_official_name <- TRUE + } + } + + if (NROW(ab_result) > 1 & found_based_on_official_name == FALSE) { # looking more and more for reliable hit ab_result_1 <- ab_result %>% filter(tolower(atc) == tolower(col)) if (nrow(ab_result_1) == 0) { @@ -106,6 +124,9 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) { if (nrow(ab_result_1) == 0) { ab_result_1 <- ab_result %>% filter(tolower(official) == tolower(col)) } + if (nrow(ab_result_1) == 0) { + ab_result_1 <- ab_result %>% filter(tolower(official) == tolower(col)) + } if (nrow(ab_result_1) == 0) { ab_result_1 <- ab_result[1, ] } @@ -114,7 +135,7 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) { if (length(ab_result) == 0) { if (verbose == TRUE) { - message('no column found for input "', col, '"') + message('No column found as input for `', col, '`.') } return(NULL) } else { @@ -122,14 +143,14 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) { if (length(result) == 0) { result <- tbl_names[tbl_names_stripped %in% ab_result] } - if (length(result) == 0) { + if (length(result) == 0 | length(result) > 1) { if (verbose == TRUE) { - message('no column found for input "', col, '"') + message('No column found as input for `', col, '`.') } return(NULL) } if (verbose == TRUE) { - message('using column `', result, '` for col "', col, '"') + message(blue(paste0("NOTE: Using column `", bold(result), "` as input for `", col, "`."))) } return(result) } diff --git a/R/mdro.R b/R/mdro.R index 24aac652..4ee55c63 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -27,9 +27,10 @@ #' @param info print progress #' @inheritParams eucast_rules #' @param metr column name of an antibiotic, see Antibiotics +#' @param verbose print additional info: missing antibiotic columns per parameter #' @param ... parameters that are passed on to methods #' @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}). +#' @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" (\href{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}{link}). #' @return Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}. #' @rdname mdro #' @importFrom dplyr %>% @@ -105,7 +106,8 @@ mdro <- function(tbl, tobr = guess_ab_col(), trim = guess_ab_col(), trsu = guess_ab_col(), - vanc = guess_ab_col()) { + vanc = guess_ab_col(), + verbose = FALSE) { if (!is.data.frame(tbl)) { stop("`tbl` must be a data frame.", call. = FALSE) @@ -152,9 +154,9 @@ mdro <- function(tbl, guideline$name <- 'WIP-Richtlijn BRMO' guideline$version <- 'Revision as 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) } @@ -168,66 +170,66 @@ mdro <- function(tbl, } # check columns - if (identical(amcl, as.name("guess_ab_col"))) { amcl <- guess_ab_col(tbl, "amcl", verbose = info) } - if (identical(amik, as.name("guess_ab_col"))) { amik <- guess_ab_col(tbl, "amik", verbose = info) } - if (identical(amox, as.name("guess_ab_col"))) { amox <- guess_ab_col(tbl, "amox", verbose = info) } - if (identical(ampi, as.name("guess_ab_col"))) { ampi <- guess_ab_col(tbl, "ampi", verbose = info) } - if (identical(azit, as.name("guess_ab_col"))) { azit <- guess_ab_col(tbl, "azit", verbose = info) } - if (identical(aztr, as.name("guess_ab_col"))) { aztr <- guess_ab_col(tbl, "aztr", verbose = info) } - if (identical(cefa, as.name("guess_ab_col"))) { cefa <- guess_ab_col(tbl, "cefa", verbose = info) } - if (identical(cfra, as.name("guess_ab_col"))) { cfra <- guess_ab_col(tbl, "cfra", verbose = info) } - if (identical(cfep, as.name("guess_ab_col"))) { cfep <- guess_ab_col(tbl, "cfep", verbose = info) } - if (identical(cfot, as.name("guess_ab_col"))) { cfot <- guess_ab_col(tbl, "cfot", verbose = info) } - if (identical(cfox, as.name("guess_ab_col"))) { cfox <- guess_ab_col(tbl, "cfox", verbose = info) } - if (identical(cfta, as.name("guess_ab_col"))) { cfta <- guess_ab_col(tbl, "cfta", verbose = info) } - if (identical(cftr, as.name("guess_ab_col"))) { cftr <- guess_ab_col(tbl, "cftr", verbose = info) } - if (identical(cfur, as.name("guess_ab_col"))) { cfur <- guess_ab_col(tbl, "cfur", verbose = info) } - if (identical(chlo, as.name("guess_ab_col"))) { chlo <- guess_ab_col(tbl, "chlo", verbose = info) } - if (identical(cipr, as.name("guess_ab_col"))) { cipr <- guess_ab_col(tbl, "cipr", verbose = info) } - if (identical(clar, as.name("guess_ab_col"))) { clar <- guess_ab_col(tbl, "clar", verbose = info) } - if (identical(clin, as.name("guess_ab_col"))) { clin <- guess_ab_col(tbl, "clin", verbose = info) } - if (identical(clox, as.name("guess_ab_col"))) { clox <- guess_ab_col(tbl, "clox", verbose = info) } - if (identical(coli, as.name("guess_ab_col"))) { coli <- guess_ab_col(tbl, "coli", verbose = info) } - if (identical(czol, as.name("guess_ab_col"))) { czol <- guess_ab_col(tbl, "czol", verbose = info) } - if (identical(dapt, as.name("guess_ab_col"))) { dapt <- guess_ab_col(tbl, "dapt", verbose = info) } - if (identical(doxy, as.name("guess_ab_col"))) { doxy <- guess_ab_col(tbl, "doxy", verbose = info) } - if (identical(erta, as.name("guess_ab_col"))) { erta <- guess_ab_col(tbl, "erta", verbose = info) } - if (identical(eryt, as.name("guess_ab_col"))) { eryt <- guess_ab_col(tbl, "eryt", verbose = info) } - if (identical(fosf, as.name("guess_ab_col"))) { fosf <- guess_ab_col(tbl, "fosf", verbose = info) } - if (identical(fusi, as.name("guess_ab_col"))) { fusi <- guess_ab_col(tbl, "fusi", verbose = info) } - if (identical(gent, as.name("guess_ab_col"))) { gent <- guess_ab_col(tbl, "gent", verbose = info) } - if (identical(imip, as.name("guess_ab_col"))) { imip <- guess_ab_col(tbl, "imip", verbose = info) } - if (identical(kana, as.name("guess_ab_col"))) { kana <- guess_ab_col(tbl, "kana", verbose = info) } - if (identical(levo, as.name("guess_ab_col"))) { levo <- guess_ab_col(tbl, "levo", verbose = info) } - if (identical(linc, as.name("guess_ab_col"))) { linc <- guess_ab_col(tbl, "linc", verbose = info) } - if (identical(line, as.name("guess_ab_col"))) { line <- guess_ab_col(tbl, "line", verbose = info) } - if (identical(mero, as.name("guess_ab_col"))) { mero <- guess_ab_col(tbl, "mero", verbose = info) } - if (identical(metr, as.name("guess_ab_col"))) { metr <- guess_ab_col(tbl, "metr", verbose = info) } - if (identical(mino, as.name("guess_ab_col"))) { mino <- guess_ab_col(tbl, "mino", verbose = info) } - if (identical(moxi, as.name("guess_ab_col"))) { moxi <- guess_ab_col(tbl, "moxi", verbose = info) } - if (identical(nali, as.name("guess_ab_col"))) { nali <- guess_ab_col(tbl, "nali", verbose = info) } - if (identical(neom, as.name("guess_ab_col"))) { neom <- guess_ab_col(tbl, "neom", verbose = info) } - if (identical(neti, as.name("guess_ab_col"))) { neti <- guess_ab_col(tbl, "neti", verbose = info) } - if (identical(nitr, as.name("guess_ab_col"))) { nitr <- guess_ab_col(tbl, "nitr", verbose = info) } - if (identical(novo, as.name("guess_ab_col"))) { novo <- guess_ab_col(tbl, "novo", verbose = info) } - if (identical(norf, as.name("guess_ab_col"))) { norf <- guess_ab_col(tbl, "norf", verbose = info) } - if (identical(oflo, as.name("guess_ab_col"))) { oflo <- guess_ab_col(tbl, "oflo", verbose = info) } - if (identical(peni, as.name("guess_ab_col"))) { peni <- guess_ab_col(tbl, "peni", verbose = info) } - if (identical(pipe, as.name("guess_ab_col"))) { pipe <- guess_ab_col(tbl, "pipe", verbose = info) } - if (identical(pita, as.name("guess_ab_col"))) { pita <- guess_ab_col(tbl, "pita", verbose = info) } - if (identical(poly, as.name("guess_ab_col"))) { poly <- guess_ab_col(tbl, "poly", verbose = info) } - if (identical(qida, as.name("guess_ab_col"))) { qida <- guess_ab_col(tbl, "qida", verbose = info) } - if (identical(rifa, as.name("guess_ab_col"))) { rifa <- guess_ab_col(tbl, "rifa", verbose = info) } - if (identical(roxi, as.name("guess_ab_col"))) { roxi <- guess_ab_col(tbl, "roxi", verbose = info) } - if (identical(siso, as.name("guess_ab_col"))) { siso <- guess_ab_col(tbl, "siso", verbose = info) } - if (identical(teic, as.name("guess_ab_col"))) { teic <- guess_ab_col(tbl, "teic", verbose = info) } - if (identical(tetr, as.name("guess_ab_col"))) { tetr <- guess_ab_col(tbl, "tetr", verbose = info) } - if (identical(tica, as.name("guess_ab_col"))) { tica <- guess_ab_col(tbl, "tica", verbose = info) } - if (identical(tige, as.name("guess_ab_col"))) { tige <- guess_ab_col(tbl, "tige", verbose = info) } - if (identical(tobr, as.name("guess_ab_col"))) { tobr <- guess_ab_col(tbl, "tobr", verbose = info) } - if (identical(trim, as.name("guess_ab_col"))) { trim <- guess_ab_col(tbl, "trim", verbose = info) } - if (identical(trsu, as.name("guess_ab_col"))) { trsu <- guess_ab_col(tbl, "trsu", verbose = info) } - if (identical(vanc, as.name("guess_ab_col"))) { vanc <- guess_ab_col(tbl, "vanc", verbose = info) } + if (identical(amcl, as.name("guess_ab_col"))) { amcl <- guess_ab_col(tbl, "amcl", verbose = verbose) } + if (identical(amik, as.name("guess_ab_col"))) { amik <- guess_ab_col(tbl, "amik", verbose = verbose) } + if (identical(amox, as.name("guess_ab_col"))) { amox <- guess_ab_col(tbl, "amox", verbose = verbose) } + if (identical(ampi, as.name("guess_ab_col"))) { ampi <- guess_ab_col(tbl, "ampi", verbose = verbose) } + if (identical(azit, as.name("guess_ab_col"))) { azit <- guess_ab_col(tbl, "azit", verbose = verbose) } + if (identical(aztr, as.name("guess_ab_col"))) { aztr <- guess_ab_col(tbl, "aztr", verbose = verbose) } + if (identical(cefa, as.name("guess_ab_col"))) { cefa <- guess_ab_col(tbl, "cefa", verbose = verbose) } + if (identical(cfra, as.name("guess_ab_col"))) { cfra <- guess_ab_col(tbl, "cfra", verbose = verbose) } + if (identical(cfep, as.name("guess_ab_col"))) { cfep <- guess_ab_col(tbl, "cfep", verbose = verbose) } + if (identical(cfot, as.name("guess_ab_col"))) { cfot <- guess_ab_col(tbl, "cfot", verbose = verbose) } + if (identical(cfox, as.name("guess_ab_col"))) { cfox <- guess_ab_col(tbl, "cfox", verbose = verbose) } + if (identical(cfta, as.name("guess_ab_col"))) { cfta <- guess_ab_col(tbl, "cfta", verbose = verbose) } + if (identical(cftr, as.name("guess_ab_col"))) { cftr <- guess_ab_col(tbl, "cftr", verbose = verbose) } + if (identical(cfur, as.name("guess_ab_col"))) { cfur <- guess_ab_col(tbl, "cfur", verbose = verbose) } + if (identical(chlo, as.name("guess_ab_col"))) { chlo <- guess_ab_col(tbl, "chlo", verbose = verbose) } + if (identical(cipr, as.name("guess_ab_col"))) { cipr <- guess_ab_col(tbl, "cipr", verbose = verbose) } + if (identical(clar, as.name("guess_ab_col"))) { clar <- guess_ab_col(tbl, "clar", verbose = verbose) } + if (identical(clin, as.name("guess_ab_col"))) { clin <- guess_ab_col(tbl, "clin", verbose = verbose) } + if (identical(clox, as.name("guess_ab_col"))) { clox <- guess_ab_col(tbl, "clox", verbose = verbose) } + if (identical(coli, as.name("guess_ab_col"))) { coli <- guess_ab_col(tbl, "coli", verbose = verbose) } + if (identical(czol, as.name("guess_ab_col"))) { czol <- guess_ab_col(tbl, "czol", verbose = verbose) } + if (identical(dapt, as.name("guess_ab_col"))) { dapt <- guess_ab_col(tbl, "dapt", verbose = verbose) } + if (identical(doxy, as.name("guess_ab_col"))) { doxy <- guess_ab_col(tbl, "doxy", verbose = verbose) } + if (identical(erta, as.name("guess_ab_col"))) { erta <- guess_ab_col(tbl, "erta", verbose = verbose) } + if (identical(eryt, as.name("guess_ab_col"))) { eryt <- guess_ab_col(tbl, "eryt", verbose = verbose) } + if (identical(fosf, as.name("guess_ab_col"))) { fosf <- guess_ab_col(tbl, "fosf", verbose = verbose) } + if (identical(fusi, as.name("guess_ab_col"))) { fusi <- guess_ab_col(tbl, "fusi", verbose = verbose) } + if (identical(gent, as.name("guess_ab_col"))) { gent <- guess_ab_col(tbl, "gent", verbose = verbose) } + if (identical(imip, as.name("guess_ab_col"))) { imip <- guess_ab_col(tbl, "imip", verbose = verbose) } + if (identical(kana, as.name("guess_ab_col"))) { kana <- guess_ab_col(tbl, "kana", verbose = verbose) } + if (identical(levo, as.name("guess_ab_col"))) { levo <- guess_ab_col(tbl, "levo", verbose = verbose) } + if (identical(linc, as.name("guess_ab_col"))) { linc <- guess_ab_col(tbl, "linc", verbose = verbose) } + if (identical(line, as.name("guess_ab_col"))) { line <- guess_ab_col(tbl, "line", verbose = verbose) } + if (identical(mero, as.name("guess_ab_col"))) { mero <- guess_ab_col(tbl, "mero", verbose = verbose) } + if (identical(metr, as.name("guess_ab_col"))) { metr <- guess_ab_col(tbl, "metr", verbose = verbose) } + if (identical(mino, as.name("guess_ab_col"))) { mino <- guess_ab_col(tbl, "mino", verbose = verbose) } + if (identical(moxi, as.name("guess_ab_col"))) { moxi <- guess_ab_col(tbl, "moxi", verbose = verbose) } + if (identical(nali, as.name("guess_ab_col"))) { nali <- guess_ab_col(tbl, "nali", verbose = verbose) } + if (identical(neom, as.name("guess_ab_col"))) { neom <- guess_ab_col(tbl, "neom", verbose = verbose) } + if (identical(neti, as.name("guess_ab_col"))) { neti <- guess_ab_col(tbl, "neti", verbose = verbose) } + if (identical(nitr, as.name("guess_ab_col"))) { nitr <- guess_ab_col(tbl, "nitr", verbose = verbose) } + if (identical(novo, as.name("guess_ab_col"))) { novo <- guess_ab_col(tbl, "novo", verbose = verbose) } + if (identical(norf, as.name("guess_ab_col"))) { norf <- guess_ab_col(tbl, "norf", verbose = verbose) } + if (identical(oflo, as.name("guess_ab_col"))) { oflo <- guess_ab_col(tbl, "oflo", verbose = verbose) } + if (identical(peni, as.name("guess_ab_col"))) { peni <- guess_ab_col(tbl, "peni", verbose = verbose) } + if (identical(pipe, as.name("guess_ab_col"))) { pipe <- guess_ab_col(tbl, "pipe", verbose = verbose) } + if (identical(pita, as.name("guess_ab_col"))) { pita <- guess_ab_col(tbl, "pita", verbose = verbose) } + if (identical(poly, as.name("guess_ab_col"))) { poly <- guess_ab_col(tbl, "poly", verbose = verbose) } + if (identical(qida, as.name("guess_ab_col"))) { qida <- guess_ab_col(tbl, "qida", verbose = verbose) } + if (identical(rifa, as.name("guess_ab_col"))) { rifa <- guess_ab_col(tbl, "rifa", verbose = verbose) } + if (identical(roxi, as.name("guess_ab_col"))) { roxi <- guess_ab_col(tbl, "roxi", verbose = verbose) } + if (identical(siso, as.name("guess_ab_col"))) { siso <- guess_ab_col(tbl, "siso", verbose = verbose) } + if (identical(teic, as.name("guess_ab_col"))) { teic <- guess_ab_col(tbl, "teic", verbose = verbose) } + if (identical(tetr, as.name("guess_ab_col"))) { tetr <- guess_ab_col(tbl, "tetr", verbose = verbose) } + if (identical(tica, as.name("guess_ab_col"))) { tica <- guess_ab_col(tbl, "tica", verbose = verbose) } + if (identical(tige, as.name("guess_ab_col"))) { tige <- guess_ab_col(tbl, "tige", verbose = verbose) } + if (identical(tobr, as.name("guess_ab_col"))) { tobr <- guess_ab_col(tbl, "tobr", verbose = verbose) } + if (identical(trim, as.name("guess_ab_col"))) { trim <- guess_ab_col(tbl, "trim", verbose = verbose) } + if (identical(trsu, as.name("guess_ab_col"))) { trsu <- guess_ab_col(tbl, "trsu", verbose = verbose) } + if (identical(vanc, as.name("guess_ab_col"))) { vanc <- guess_ab_col(tbl, "vanc", verbose = verbose) } col.list <- c(amcl, amik, amox, ampi, azit, 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, @@ -301,6 +303,10 @@ mdro <- function(tbl, trsu <- col.list[trsu] vanc <- col.list[vanc] + ab_missing <- function(ab) { + isTRUE(ab %in% c(NULL, NA)) | length(ab) == 0 + } + # antibiotic classes aminoglycosides <- c(tobr, gent) # can also be kana but that one is often intrinsic R cephalosporins <- c(cfep, cfot, cfox, cfra, cfta, cftr, cfur, czol) @@ -310,7 +316,7 @@ mdro <- function(tbl, # helper function for editing the table trans_tbl <- function(to, rows, cols, any_all) { - cols <- cols[!is.na(cols)] + cols <- cols[!ab_missing(cols)] if (length(rows) > 0 & length(cols) > 0) { if (any_all == "any") { col_filter <- which(tbl[, cols] == 'R') @@ -404,9 +410,9 @@ mdro <- function(tbl, if (guideline$country$code == 'nl') { # Netherlands ------------------------------------------------------------- - aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)] - fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)] - carbapenems <- carbapenems[!is.na(carbapenems)] + aminoglycosides <- aminoglycosides[!ab_missing(aminoglycosides)] + fluoroquinolones <- fluoroquinolones[!ab_missing(fluoroquinolones)] + carbapenems <- carbapenems[!ab_missing(carbapenems)] # Table 1 trans_tbl(3, @@ -434,11 +440,11 @@ mdro <- function(tbl, trsu, "all") - if (!is.na(mero) & !is.na(imip) - & !is.na(gent) & !is.na(tobr) - & !is.na(cipr) - & !is.na(cfta) - & !is.na(pita) ) { + if (!ab_missing(mero) & !ab_missing(imip) + & !ab_missing(gent) & !ab_missing(tobr) + & !ab_missing(cipr) + & !ab_missing(cfta) + & !ab_missing(pita) ) { tbl <- tbl %>% mutate( psae = 0, psae = ifelse(mero == "R" | imip == "R", psae + 1, psae), diff --git a/R/rsi.R b/R/rsi.R index a7cde301..455c5250 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -25,7 +25,10 @@ #' @rdname as.rsi #' @param x vector #' @param threshold maximum fraction of \code{x} that is allowed to fail transformation, see Examples -#' @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. +#' @details +#' \strong{NOTE:} This function does not translate MIC values to RSI values. If more than 50\% of the input resembles MIC values, it will warn about this.\cr You can use \code{\link{eucast_rules}} to (1) apply inferred susceptibility and resistance based on results of other antibiotics and (2) apply intrinsic resistance based on taxonomic properties of a microorganism. +#' +#' 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} #' @keywords rsi #' @export @@ -64,7 +67,7 @@ as.rsi <- function(x) { } else if (identical(levels(x), c("S", "I", "R"))) { structure(x, class = c('rsi', 'ordered', 'factor')) } else { - if (mic_like(x) > 0.5) { + if (input_resembles_mic(x) > 0.5) { warning("`as.rsi` is intended to clean antimicrobial interpretations - not to interpret MIC values.", call. = FALSE) } @@ -109,7 +112,7 @@ as.rsi <- function(x) { } } -mic_like <- function(x) { +input_resembles_mic <- function(x) { mic <- x %>% gsub("[^0-9.,]+", "", .) %>% unique() diff --git a/codecov.yml b/codecov.yml new file mode 100644 index 00000000..f3502d9a --- /dev/null +++ b/codecov.yml @@ -0,0 +1,16 @@ +codecov: + notify: + require_ci_to_pass: no + ci: + - !appveyor # ignore CI builds by AppVeyor + +comment: no + +coverage: + precision: 5 + round: up + range: "0...100" + status: + project: no + patch: no + changes: no diff --git a/docs/reference/as.rsi.html b/docs/reference/as.rsi.html index e638e498..c8755195 100644 --- a/docs/reference/as.rsi.html +++ b/docs/reference/as.rsi.html @@ -80,7 +80,7 @@ AMR (for R) - 0.6.0 + 0.6.1.9002 @@ -266,7 +266,8 @@

Details

-

The function is.rsi.eligible returns TRUE when a columns contains only valid antimicrobial interpretations (S and/or I and/or R), and FALSE otherwise.

+

NOTE: This function does not translate MIC values to RSI values. If more than 50% of the input resembles MIC values, it will warn about this.
You can use eucast_rules to (1) apply inferred susceptibility and resistance based on results of other antibiotics and (2) apply intrinsic resistance based on taxonomic properties of a microorganism.

+

The function is.rsi.eligible returns TRUE when a columns contains only valid antimicrobial interpretations (S and/or I and/or R), and FALSE otherwise.

Read more on our website!

diff --git a/docs/reference/eucast_rules.html b/docs/reference/eucast_rules.html index ca495fa5..512f3b8d 100644 --- a/docs/reference/eucast_rules.html +++ b/docs/reference/eucast_rules.html @@ -329,7 +329,8 @@

Details

-

The file used for applying all EUCAST rules can be retrieved with eucast_rules_file(). It returns an easily readable data set containing all rules. The original TSV file (tab separated file) that is being read by this function can be found when running this command:
+

NOTE: This function does not translate MIC values to RSI values. It only applies (1) inferred susceptibility and resistance based on results of other antibiotics and (2) intrinsic resistance based on taxonomic properties of a microorganism.

+

The file used for applying all EUCAST rules can be retrieved with eucast_rules_file(). It returns an easily readable data set containing all rules. The original TSV file (tab separated file) that is being read by this function can be found when running this command:
AMR::EUCAST_RULES_FILE_LOCATION (without brackets).

In the source code it is located under ./inst/eucast/eucast_rules.tsv.

Note: When ampicillin (J01CA01) is not available but amoxicillin (J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance.

diff --git a/docs/reference/first_isolate.html b/docs/reference/first_isolate.html index 84685f3e..9874bce8 100644 --- a/docs/reference/first_isolate.html +++ b/docs/reference/first_isolate.html @@ -80,7 +80,7 @@ AMR (for R) - 0.6.0 + 0.6.1.9002 @@ -340,7 +340,7 @@

WHY THIS IS SO IMPORTANT
To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode [1]. If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all S. aureus isolates would be overestimated, because you included this MRSA more than once. It would be selection bias.

-

The function filter_first_isolate is essentially equal to:

+

The functions filter_first_isolate and filter_first_weighted_isolate are helper functions to quickly filter on first isolates. The function filter_first_isolate is essentially equal to:

  tbl %>%
    mutate(only_firsts = first_isolate(tbl, ...)) %>%
    filter(only_firsts == TRUE) %>%
@@ -359,9 +359,9 @@ To conduct an analysis of antimicrobial resistance, you should only include the
     
     

There are two ways to determine whether isolates can be included as first weighted isolates which will give generally the same results:

1. Using type = "keyantibiotics" and parameter ignore_I
- Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With ignore_I = FALSE, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2.

+ Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With ignore_I = FALSE, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the key_antibiotics function.

2. Using type = "points" and parameter points_threshold
- A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, an isolate will be (re)selected as a first weighted isolate.

+ A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, which default to 2, an isolate will be (re)selected as a first weighted isolate.

Read more on our website!

@@ -408,8 +408,8 @@ To conduct an analysis of antimicrobial resistance, you should only include the # Have a look at A and B. # B is more reliable because every isolate is only counted once. -# Gentamicin resitance in hospital D appears to be 5.4% higher than -# when you (erroneously) would have used all isolates! +# Gentamicin resitance in hospital D appears to be 3.1% higher than +# when you (erroneously) would have used all isolates for analysis. ## OTHER EXAMPLES: diff --git a/docs/reference/key_antibiotics.html b/docs/reference/key_antibiotics.html index 52ca71e3..a052f97c 100644 --- a/docs/reference/key_antibiotics.html +++ b/docs/reference/key_antibiotics.html @@ -80,7 +80,7 @@ AMR (for R) - 0.6.0 + 0.6.1.9002 @@ -326,9 +326,9 @@

There are two ways to determine whether isolates can be included as first weighted isolates which will give generally the same results:

1. Using type = "keyantibiotics" and parameter ignore_I
- Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With ignore_I = FALSE, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2.

+ Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With ignore_I = FALSE, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the key_antibiotics function.

2. Using type = "points" and parameter points_threshold
- A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, an isolate will be (re)selected as a first weighted isolate.

+ A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds points_threshold, which default to 2, an isolate will be (re)selected as a first weighted isolate.

Read more on our website!

diff --git a/docs/reference/mdro.html b/docs/reference/mdro.html index 7ea91ae0..a9871569 100644 --- a/docs/reference/mdro.html +++ b/docs/reference/mdro.html @@ -80,7 +80,7 @@ AMR (for R) - 0.6.0 + 0.6.1.9002 @@ -271,7 +271,7 @@ teic = guess_ab_col(), tetr = guess_ab_col(), tica = guess_ab_col(), tige = guess_ab_col(), tobr = guess_ab_col(), trim = guess_ab_col(), - trsu = guess_ab_col(), vanc = guess_ab_col()) + trsu = guess_ab_col(), vanc = guess_ab_col(), verbose = FALSE) brmo(..., country = "nl") @@ -538,6 +538,10 @@ vanc

column name of an antibiotic, see Antibiotics

+ + verbose +

print additional info: missing antibiotic columns per parameter

+ ...

parameters that are passed on to methods

@@ -550,7 +554,7 @@

Details

-

When country will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf).

+

When country will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (link).

Antibiotics

diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index a3b7f536..a9d5e8ec 100755 --- a/man/as.rsi.Rd +++ b/man/as.rsi.Rd @@ -24,6 +24,8 @@ Ordered factor with new class \code{rsi} 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. } \details{ +\strong{NOTE:} This function does not translate MIC values to RSI values. If more than 50\% of the input resembles MIC values, it will warn about this.\cr You can use \code{\link{eucast_rules}} to (1) apply inferred susceptibility and resistance based on results of other antibiotics and (2) apply intrinsic resistance based on taxonomic properties of a microorganism. + 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. } \section{Read more on our website!}{ diff --git a/man/eucast_rules.Rd b/man/eucast_rules.Rd index 17e785c4..314a2553 100644 --- a/man/eucast_rules.Rd +++ b/man/eucast_rules.Rd @@ -82,6 +82,8 @@ The input of \code{tbl_}, possibly with edited values of antibiotics. Or, if \co 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. } \details{ +\strong{NOTE:} This function does not translate MIC values to RSI values. It only applies (1) inferred susceptibility and resistance based on results of other antibiotics and (2) intrinsic resistance based on taxonomic properties of a microorganism. + The file used for applying all EUCAST rules can be retrieved with \code{\link{eucast_rules_file}()}. It returns an easily readable data set containing all rules. The original TSV file (tab separated file) that is being read by this function can be found when running this command: \cr \code{AMR::EUCAST_RULES_FILE_LOCATION} (without brackets). diff --git a/man/first_isolate.Rd b/man/first_isolate.Rd index 84cdbd4b..b8cc97df 100755 --- a/man/first_isolate.Rd +++ b/man/first_isolate.Rd @@ -68,7 +68,7 @@ Determine first (weighted) isolates of all microorganisms of every patient per e \strong{WHY THIS IS SO IMPORTANT} \cr To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode \href{https://www.ncbi.nlm.nih.gov/pubmed/17304462}{[1]}. If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all \emph{S. aureus} isolates would be overestimated, because you included this MRSA more than once. It would be \href{https://en.wikipedia.org/wiki/Selection_bias}{selection bias}. -The function \code{filter_first_isolate} is essentially equal to: +The functions \code{filter_first_isolate} and \code{filter_first_weighted_isolate} are helper functions to quickly filter on first isolates. The function \code{filter_first_isolate} is essentially equal to: \preformatted{ tbl \%>\% mutate(only_firsts = first_isolate(tbl, ...)) \%>\% @@ -90,10 +90,10 @@ The function \code{filter_first_weighted_isolate} is essentially equal to: There are two ways to determine whether isolates can be included as first \emph{weighted} isolates which will give generally the same results: \cr \strong{1. Using} \code{type = "keyantibiotics"} \strong{and parameter} \code{ignore_I} \cr - Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. \cr + Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the \code{\link{key_antibiotics}} function. \cr \strong{2. Using} \code{type = "points"} \strong{and parameter} \code{points_threshold} \cr - A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, an isolate will be (re)selected as a first weighted isolate. + A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which default to \code{2}, an isolate will be (re)selected as a first weighted isolate. } \section{Read more on our website!}{ @@ -135,8 +135,8 @@ B <- septic_patients \%>\% # Have a look at A and B. # B is more reliable because every isolate is only counted once. -# Gentamicin resitance in hospital D appears to be 5.4\% higher than -# when you (erroneously) would have used all isolates! +# Gentamicin resitance in hospital D appears to be 3.1\% higher than +# when you (erroneously) would have used all isolates for analysis. ## OTHER EXAMPLES: diff --git a/man/key_antibiotics.Rd b/man/key_antibiotics.Rd index f9584e64..b632b967 100755 --- a/man/key_antibiotics.Rd +++ b/man/key_antibiotics.Rd @@ -68,10 +68,10 @@ The function \code{key_antibiotics} returns a character vector with 12 antibioti There are two ways to determine whether isolates can be included as first \emph{weighted} isolates which will give generally the same results: \cr \strong{1. Using} \code{type = "keyantibiotics"} \strong{and parameter} \code{ignore_I} \cr - Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. \cr + Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the \code{\link{key_antibiotics}} function. \cr \strong{2. Using} \code{type = "points"} \strong{and parameter} \code{points_threshold} \cr - A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, an isolate will be (re)selected as a first weighted isolate. + A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which default to \code{2}, an isolate will be (re)selected as a first weighted isolate. } \section{Read more on our website!}{ diff --git a/man/mdro.Rd b/man/mdro.Rd index 69b0302f..e31e1421 100644 --- a/man/mdro.Rd +++ b/man/mdro.Rd @@ -37,7 +37,7 @@ mdro(tbl, country = NULL, col_mo = NULL, info = TRUE, teic = guess_ab_col(), tetr = guess_ab_col(), tica = guess_ab_col(), tige = guess_ab_col(), tobr = guess_ab_col(), trim = guess_ab_col(), - trsu = guess_ab_col(), vanc = guess_ab_col()) + trsu = guess_ab_col(), vanc = guess_ab_col(), verbose = FALSE) brmo(..., country = "nl") @@ -174,6 +174,8 @@ eucast_exceptional_phenotypes(tbl, country = "EUCAST", ...) \item{vanc}{column name of an antibiotic, see Antibiotics} +\item{verbose}{print additional info: missing antibiotic columns per parameter} + \item{...}{parameters that are passed on to methods} } \value{ @@ -183,7 +185,7 @@ Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}. Determine which isolates are multidrug-resistant organisms (MDRO) according to country-specific guidelines. } \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}). +When \code{country} will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\href{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}{link}). } \section{Antibiotics}{ diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R index 83078eff..7521eba6 100755 --- a/tests/testthat/test-mdro.R +++ b/tests/testthat/test-mdro.R @@ -53,4 +53,32 @@ test_that("mdro works", { # still working on German guidelines expect_error(suppressWarnings(mrgn(septic_patients, info = TRUE))) + # test Dutch P. aeruginosa MDRO + expect_equal(suppressWarnings( + as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"), + cfta = "S", + cipr = "S", + mero = "S", + imip = "S", + gent = "S", + tobr = "S", + pita = "S"), + country = "nl", + col_mo = "mo", + info = FALSE)) + ), "Negative") + expect_equal(suppressWarnings( + as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"), + cefta = "R", + cipr = "R", + mero = "R", + imip = "R", + gent = "R", + tobr = "R", + pita = "R"), + country = "nl", + col_mo = "mo", + info = FALSE)) + ), "Positive") + })