mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 23:21:56 +02:00
cfta streptococci, codecov.yml
This commit is contained in:
@ -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).
|
||||
#'
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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)
|
||||
}
|
||||
|
||||
154
R/mdro.R
154
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),
|
||||
|
||||
9
R/rsi.R
9
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()
|
||||
|
||||
Reference in New Issue
Block a user