mirror of https://github.com/msberends/AMR.git
(v2.1.1.9050) vctrs fix for `sir`, small documentation fixes
This commit is contained in:
parent
9bf7584d58
commit
bdbf5198a2
|
@ -1,6 +1,6 @@
|
||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 2.1.1.9049
|
Version: 2.1.1.9050
|
||||||
Date: 2024-06-14
|
Date: 2024-06-15
|
||||||
Title: Antimicrobial Resistance Data Analysis
|
Title: Antimicrobial Resistance Data Analysis
|
||||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||||
data analysis and to work with microbial and antimicrobial properties by
|
data analysis and to work with microbial and antimicrobial properties by
|
||||||
|
|
|
@ -84,6 +84,7 @@ S3method(plot,mic)
|
||||||
S3method(plot,resistance_predict)
|
S3method(plot,resistance_predict)
|
||||||
S3method(plot,sir)
|
S3method(plot,sir)
|
||||||
S3method(print,ab)
|
S3method(print,ab)
|
||||||
|
S3method(print,ab_selector)
|
||||||
S3method(print,av)
|
S3method(print,av)
|
||||||
S3method(print,bug_drug_combinations)
|
S3method(print,bug_drug_combinations)
|
||||||
S3method(print,custom_eucast_rules)
|
S3method(print,custom_eucast_rules)
|
||||||
|
|
2
NEWS.md
2
NEWS.md
|
@ -1,4 +1,4 @@
|
||||||
# AMR 2.1.1.9049
|
# AMR 2.1.1.9050
|
||||||
|
|
||||||
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)*
|
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)*
|
||||||
|
|
||||||
|
|
|
@ -524,6 +524,9 @@ word_wrap <- function(...,
|
||||||
# otherwise, give a 'click to run' popup
|
# otherwise, give a 'click to run' popup
|
||||||
parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
|
parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
|
||||||
txt = parts[cmds & parts %unlike% "[.]"])
|
txt = parts[cmds & parts %unlike% "[.]"])
|
||||||
|
# text starting with `?` must also lead to the help page
|
||||||
|
parts[parts %like% "^[?]"] <- font_url(url = paste0("ide:help:AMR::", gsub("()", "", gsub("^[?]", "", parts[parts %like% "^[?]"]), fixed = TRUE)),
|
||||||
|
txt = parts[parts %like% "^[?]"])
|
||||||
msg <- paste0(parts, collapse = "`")
|
msg <- paste0(parts, collapse = "`")
|
||||||
}
|
}
|
||||||
msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg)
|
msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg)
|
||||||
|
|
107
R/ab_selectors.R
107
R/ab_selectors.R
|
@ -57,59 +57,31 @@
|
||||||
#' example_isolates
|
#' example_isolates
|
||||||
#'
|
#'
|
||||||
#'
|
#'
|
||||||
#' # Examples sections below are split into 'base R', 'dplyr', and 'data.table':
|
#' # Examples sections below are split into 'dplyr', 'base R', and 'data.table':
|
||||||
#'
|
|
||||||
#'
|
|
||||||
#' # base R ------------------------------------------------------------------
|
|
||||||
#'
|
|
||||||
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
|
||||||
#' example_isolates[, carbapenems()]
|
|
||||||
#'
|
|
||||||
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
|
|
||||||
#' example_isolates[, c("mo", aminoglycosides())]
|
|
||||||
#'
|
|
||||||
#' # select only antibiotic columns with DDDs for oral treatment
|
|
||||||
#' example_isolates[, administrable_per_os()]
|
|
||||||
#'
|
|
||||||
#' # filter using any() or all()
|
|
||||||
#' example_isolates[any(carbapenems() == "R"), ]
|
|
||||||
#' subset(example_isolates, any(carbapenems() == "R"))
|
|
||||||
#'
|
|
||||||
#' # filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
|
|
||||||
#' example_isolates[any(carbapenems()), ]
|
|
||||||
#' example_isolates[all(carbapenems()), ]
|
|
||||||
#'
|
|
||||||
#' # filter with multiple antibiotic selectors using c()
|
|
||||||
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
|
|
||||||
#'
|
|
||||||
#' # filter + select in one go: get penicillins in carbapenem-resistant strains
|
|
||||||
#' example_isolates[any(carbapenems() == "R"), penicillins()]
|
|
||||||
#'
|
|
||||||
#' # You can combine selectors with '&' to be more specific. For example,
|
|
||||||
#' # penicillins() would select benzylpenicillin ('peni G') and
|
|
||||||
#' # administrable_per_os() would select erythromycin. Yet, when combined these
|
|
||||||
#' # drugs are both omitted since benzylpenicillin is not administrable per os
|
|
||||||
#' # and erythromycin is not a penicillin:
|
|
||||||
#' example_isolates[, penicillins() & administrable_per_os()]
|
|
||||||
#'
|
|
||||||
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus
|
|
||||||
#' # very flexible. For instance, to select antibiotic columns with an oral DDD
|
|
||||||
#' # of at least 1 gram:
|
|
||||||
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
|
|
||||||
#'
|
#'
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
#' # dplyr -------------------------------------------------------------------
|
#' # dplyr -------------------------------------------------------------------
|
||||||
#'
|
#'
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#' tibble(kefzol = random_sir(5)) %>%
|
#'. example_isolates %>% select(carbapenems())
|
||||||
#' select(cephalosporins())
|
#' }
|
||||||
|
#'
|
||||||
|
#' if (require("dplyr")) {
|
||||||
|
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
|
||||||
|
#' example_isolates %>% select(mo, aminoglycosides())
|
||||||
|
#' }
|
||||||
|
#'
|
||||||
|
#' if (require("dplyr")) {
|
||||||
|
#' # select only antibiotic columns with DDDs for oral treatment
|
||||||
|
#'. example_isolates %>% select(administrable_per_os())
|
||||||
#' }
|
#' }
|
||||||
#'
|
#'
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#' # get AMR for all aminoglycosides e.g., per ward:
|
#' # get AMR for all aminoglycosides e.g., per ward:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' group_by(ward) %>%
|
#' group_by(ward) %>%
|
||||||
#' summarise(across(aminoglycosides(), resistance))
|
#' summarise(across(aminoglycosides(),
|
||||||
|
#' resistance))
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#' # You can combine selectors with '&' to be more specific:
|
#' # You can combine selectors with '&' to be more specific:
|
||||||
|
@ -121,7 +93,8 @@
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
|
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
|
||||||
#' group_by(ward) %>%
|
#' group_by(ward) %>%
|
||||||
#' summarise(across(not_intrinsic_resistant(), resistance))
|
#' summarise_at(not_intrinsic_resistant(),
|
||||||
|
#' resistance)
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#' # get susceptibility for antibiotics whose name contains "trim":
|
#' # get susceptibility for antibiotics whose name contains "trim":
|
||||||
|
@ -187,6 +160,44 @@
|
||||||
#' }
|
#' }
|
||||||
#'
|
#'
|
||||||
#'
|
#'
|
||||||
|
#' # base R ------------------------------------------------------------------
|
||||||
|
#'
|
||||||
|
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||||
|
#' example_isolates[, carbapenems()]
|
||||||
|
#'
|
||||||
|
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
|
||||||
|
#' example_isolates[, c("mo", aminoglycosides())]
|
||||||
|
#'
|
||||||
|
#' # select only antibiotic columns with DDDs for oral treatment
|
||||||
|
#' example_isolates[, administrable_per_os()]
|
||||||
|
#'
|
||||||
|
#' # filter using any() or all()
|
||||||
|
#' example_isolates[any(carbapenems() == "R"), ]
|
||||||
|
#' subset(example_isolates, any(carbapenems() == "R"))
|
||||||
|
#'
|
||||||
|
#' # filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
|
||||||
|
#' example_isolates[any(carbapenems()), ]
|
||||||
|
#' example_isolates[all(carbapenems()), ]
|
||||||
|
#'
|
||||||
|
#' # filter with multiple antibiotic selectors using c()
|
||||||
|
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
|
||||||
|
#'
|
||||||
|
#' # filter + select in one go: get penicillins in carbapenem-resistant strains
|
||||||
|
#' example_isolates[any(carbapenems() == "R"), penicillins()]
|
||||||
|
#'
|
||||||
|
#' # You can combine selectors with '&' to be more specific. For example,
|
||||||
|
#' # penicillins() would select benzylpenicillin ('peni G') and
|
||||||
|
#' # administrable_per_os() would select erythromycin. Yet, when combined these
|
||||||
|
#' # drugs are both omitted since benzylpenicillin is not administrable per os
|
||||||
|
#' # and erythromycin is not a penicillin:
|
||||||
|
#' example_isolates[, penicillins() & administrable_per_os()]
|
||||||
|
#'
|
||||||
|
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus
|
||||||
|
#' # very flexible. For instance, to select antibiotic columns with an oral DDD
|
||||||
|
#' # of at least 1 gram:
|
||||||
|
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
|
||||||
|
#'
|
||||||
|
#'
|
||||||
#' # data.table --------------------------------------------------------------
|
#' # data.table --------------------------------------------------------------
|
||||||
#'
|
#'
|
||||||
#' # data.table is supported as well, just use it in the same way as with
|
#' # data.table is supported as well, just use it in the same way as with
|
||||||
|
@ -679,6 +690,16 @@ ab_select_exec <- function(function_name,
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#' @method print ab_selector
|
||||||
|
#' @export
|
||||||
|
#' @noRd
|
||||||
|
print.ab_selector <- function(x, ...) {
|
||||||
|
warning_("It should never be needed to print an antibiotic selector class. Are you using data.table? Then add the argument `with = FALSE`, see our examples at `?ab_selector`.",
|
||||||
|
immediate = TRUE)
|
||||||
|
cat("Class 'ab_selector'\n")
|
||||||
|
print(as.character(x), quote = FALSE)
|
||||||
|
}
|
||||||
|
|
||||||
#' @method c ab_selector
|
#' @method c ab_selector
|
||||||
#' @export
|
#' @export
|
||||||
#' @noRd
|
#' @noRd
|
||||||
|
|
|
@ -462,7 +462,7 @@ eucast_rules <- function(x,
|
||||||
font_red(paste0(
|
font_red(paste0(
|
||||||
"v", utils::packageDescription("AMR")$Version, ", ",
|
"v", utils::packageDescription("AMR")$Version, ", ",
|
||||||
format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y")
|
format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y")
|
||||||
)), "), see ?eucast_rules\n"
|
)), "), see `?eucast_rules`\n"
|
||||||
))
|
))
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
|
|
|
@ -188,7 +188,7 @@ key_antimicrobials <- function(x = NULL,
|
||||||
"No columns available ",
|
"No columns available ",
|
||||||
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
|
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
|
||||||
),
|
),
|
||||||
"as key antimicrobials for ", name, "s. See ?key_antimicrobials."
|
"as key antimicrobials for ", name, "s. See `?key_antimicrobials`."
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
2
R/pca.R
2
R/pca.R
|
@ -113,7 +113,7 @@ pca <- function(x,
|
||||||
|
|
||||||
x <- as.data.frame(new_list, stringsAsFactors = FALSE)
|
x <- as.data.frame(new_list, stringsAsFactors = FALSE)
|
||||||
if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
|
if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
|
||||||
warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in ?pca.", call = FALSE)
|
warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in `?pca`.", call = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
# set column names
|
# set column names
|
||||||
|
|
|
@ -231,7 +231,7 @@ resistance_predict <- function(x,
|
||||||
prediction <- predictmodel$fit
|
prediction <- predictmodel$fit
|
||||||
se <- predictmodel$se.fit
|
se <- predictmodel$se.fit
|
||||||
} else {
|
} else {
|
||||||
stop("no valid model selected. See ?resistance_predict.")
|
stop("no valid model selected. See `?resistance_predict`.")
|
||||||
}
|
}
|
||||||
|
|
||||||
# prepare the output dataframe
|
# prepare the output dataframe
|
||||||
|
|
88
R/sir.R
88
R/sir.R
|
@ -158,6 +158,51 @@
|
||||||
#'
|
#'
|
||||||
#' # For INTERPRETING disk diffusion and MIC values -----------------------
|
#' # For INTERPRETING disk diffusion and MIC values -----------------------
|
||||||
#'
|
#'
|
||||||
|
#' \donttest{
|
||||||
|
#' ## Using dplyr -------------------------------------------------
|
||||||
|
#' if (require("dplyr")) {
|
||||||
|
#' # approaches that all work without additional arguments:
|
||||||
|
#' df %>% mutate_if(is.mic, as.sir)
|
||||||
|
#' df %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
|
||||||
|
#' df %>% mutate(across(where(is.mic), as.sir))
|
||||||
|
#' df %>% mutate_at(vars(AMP:TOB), as.sir)
|
||||||
|
#' df %>% mutate(across(AMP:TOB, as.sir))
|
||||||
|
#'
|
||||||
|
#' # approaches that all work with additional arguments:
|
||||||
|
#' df %>% mutate_if(is.mic, as.sir, mo = "column1", guideline = "CLSI")
|
||||||
|
#' df %>% mutate(across(where(is.mic),
|
||||||
|
#' function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
|
||||||
|
#' df %>% mutate_at(vars(AMP:TOB), as.sir, mo = "column1", guideline = "CLSI")
|
||||||
|
#' df %>% mutate(across(AMP:TOB,
|
||||||
|
#' function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
|
||||||
|
#'
|
||||||
|
#' # for veterinary breakpoints, add 'host':
|
||||||
|
#' df %>% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "species_column")
|
||||||
|
#' df %>% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "horse")
|
||||||
|
#' df %>% mutate(across(where(is.mic),
|
||||||
|
#' function(x) as.sir(x, guideline = "CLSI", host = "species_column")))
|
||||||
|
#' df %>% mutate_at(vars(AMP:TOB), as.sir, guideline = "CLSI", host = "species_column")
|
||||||
|
#' df %>% mutate(across(AMP:TOB,
|
||||||
|
#' function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
|
||||||
|
#'
|
||||||
|
#' # to include information about urinary tract infections (UTI)
|
||||||
|
#' data.frame(mo = "E. coli",
|
||||||
|
#' nitrofuratoin = c("<= 2", 32),
|
||||||
|
#' from_the_bladder = c(TRUE, FALSE)) %>%
|
||||||
|
#' as.sir(uti = "from_the_bladder")
|
||||||
|
#'
|
||||||
|
#' data.frame(mo = "E. coli",
|
||||||
|
#' nitrofuratoin = c("<= 2", 32),
|
||||||
|
#' specimen = c("urine", "blood")) %>%
|
||||||
|
#' as.sir() # automatically determines urine isolates
|
||||||
|
#'
|
||||||
|
#' df %>%
|
||||||
|
#' mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
|
||||||
|
#' }
|
||||||
|
#'
|
||||||
|
#'
|
||||||
|
#' ## Using base R ------------------------------------------------
|
||||||
|
#'
|
||||||
#' # a whole data set, even with combined MIC values and disk zones
|
#' # a whole data set, even with combined MIC values and disk zones
|
||||||
#' df <- data.frame(
|
#' df <- data.frame(
|
||||||
#' microorganism = "Escherichia coli",
|
#' microorganism = "Escherichia coli",
|
||||||
|
@ -187,36 +232,6 @@
|
||||||
#' guideline = "EUCAST"
|
#' guideline = "EUCAST"
|
||||||
#' )
|
#' )
|
||||||
#'
|
#'
|
||||||
#' \donttest{
|
|
||||||
#' # the dplyr way
|
|
||||||
#' if (require("dplyr")) {
|
|
||||||
#' df %>% mutate_if(is.mic, as.sir)
|
|
||||||
#' df %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
|
|
||||||
#' df %>% mutate(across(where(is.mic), as.sir))
|
|
||||||
#' df %>% mutate_at(vars(AMP:TOB), as.sir)
|
|
||||||
#' df %>% mutate(across(AMP:TOB, as.sir))
|
|
||||||
#'
|
|
||||||
#' df %>%
|
|
||||||
#' mutate_at(vars(AMP:TOB), as.sir, mo = "microorganism")
|
|
||||||
#'
|
|
||||||
#' # to include information about urinary tract infections (UTI)
|
|
||||||
#' data.frame(
|
|
||||||
#' mo = "E. coli",
|
|
||||||
#' NIT = c("<= 2", 32),
|
|
||||||
#' from_the_bladder = c(TRUE, FALSE)
|
|
||||||
#' ) %>%
|
|
||||||
#' as.sir(uti = "from_the_bladder")
|
|
||||||
#'
|
|
||||||
#' data.frame(
|
|
||||||
#' mo = "E. coli",
|
|
||||||
#' NIT = c("<= 2", 32),
|
|
||||||
#' specimen = c("urine", "blood")
|
|
||||||
#' ) %>%
|
|
||||||
#' as.sir() # automatically determines urine isolates
|
|
||||||
#'
|
|
||||||
#' df %>%
|
|
||||||
#' mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
|
|
||||||
#' }
|
|
||||||
#'
|
#'
|
||||||
#' # For CLEANING existing SIR values ------------------------------------
|
#' # For CLEANING existing SIR values ------------------------------------
|
||||||
#'
|
#'
|
||||||
|
@ -1121,6 +1136,7 @@ as_sir_method <- function(method_short,
|
||||||
suppressMessages(suppressWarnings(ab_name(ab_current, language = NULL, tolower = TRUE))),
|
suppressMessages(suppressWarnings(ab_name(ab_current, language = NULL, tolower = TRUE))),
|
||||||
" (", ab_current, ")"
|
" (", ab_current, ")"
|
||||||
)
|
)
|
||||||
|
notes <- character(0)
|
||||||
|
|
||||||
# gather all available breakpoints for current MO
|
# gather all available breakpoints for current MO
|
||||||
breakpoints_current <- breakpoints %pm>%
|
breakpoints_current <- breakpoints %pm>%
|
||||||
|
@ -1165,7 +1181,8 @@ as_sir_method <- function(method_short,
|
||||||
subset(host_match == TRUE)
|
subset(host_match == TRUE)
|
||||||
} else {
|
} else {
|
||||||
# no breakpoint found for this host, so sort on mostly available guidelines
|
# no breakpoint found for this host, so sort on mostly available guidelines
|
||||||
msgs <- c(msgs, paste0("No breakpoints available for ", font_bold(host_current), " for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " instead."))
|
notes <- c(notes, paste0("No breakpoints available for ", font_bold(host_current), " for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " instead."))
|
||||||
|
# msgs <- c(msgs, paste0("No breakpoints available for ", font_bold(host_current), " for ", ab_formatted, " in ", mo_formatted, " - using ", font_bold(breakpoints_current$host[1]), " instead."))
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1243,14 +1260,15 @@ as_sir_method <- function(method_short,
|
||||||
mo_user = rep(mo.bak[match(mo_current, df$mo)][1], length(rows)),
|
mo_user = rep(mo.bak[match(mo_current, df$mo)][1], length(rows)),
|
||||||
ab = rep(ab_current, length(rows)),
|
ab = rep(ab_current, length(rows)),
|
||||||
mo = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)),
|
mo = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)),
|
||||||
|
method = rep(method_coerced, length(rows)),
|
||||||
input = as.double(values),
|
input = as.double(values),
|
||||||
outcome = as.sir(new_sir),
|
outcome = as.sir(new_sir),
|
||||||
method = rep(method_coerced, length(rows)),
|
|
||||||
breakpoint_S_R = rep(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
|
|
||||||
guideline = rep(guideline_coerced, length(rows)),
|
|
||||||
host = rep(breakpoints_current[, "host", drop = TRUE], length(rows)),
|
host = rep(breakpoints_current[, "host", drop = TRUE], length(rows)),
|
||||||
|
notes = rep(paste0(notes, collapse = " "), length(rows)),
|
||||||
|
guideline = rep(guideline_coerced, length(rows)),
|
||||||
ref_table = rep(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)),
|
ref_table = rep(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)),
|
||||||
uti = rep(breakpoints_current[, "uti", drop = TRUE], length(rows)),
|
uti = rep(breakpoints_current[, "uti", drop = TRUE], length(rows)),
|
||||||
|
breakpoint_S_R = rep(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
|
||||||
stringsAsFactors = FALSE
|
stringsAsFactors = FALSE
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
@ -1268,6 +1286,8 @@ as_sir_method <- function(method_short,
|
||||||
}
|
}
|
||||||
if (isTRUE(rise_warning)) {
|
if (isTRUE(rise_warning)) {
|
||||||
message(font_rose_bg(" WARNING "))
|
message(font_rose_bg(" WARNING "))
|
||||||
|
} else if (length(notes) > 0) {
|
||||||
|
message(font_yellow_bg(" NOTES "))
|
||||||
} else if (length(msgs) == 0) {
|
} else if (length(msgs) == 0) {
|
||||||
message(font_green_bg(" OK "))
|
message(font_green_bg(" OK "))
|
||||||
} else {
|
} else {
|
||||||
|
|
15
R/vctrs.R
15
R/vctrs.R
|
@ -109,10 +109,13 @@ vec_ptype_abbr.disk <- function(x, ...) {
|
||||||
"dsk"
|
"dsk"
|
||||||
}
|
}
|
||||||
vec_ptype2.disk.default <- function (x, y, ..., x_arg = "", y_arg = "") {
|
vec_ptype2.disk.default <- function (x, y, ..., x_arg = "", y_arg = "") {
|
||||||
x
|
NA_disk_[0]
|
||||||
}
|
}
|
||||||
vec_ptype2.disk.disk <- function(x, y, ...) {
|
vec_ptype2.disk.disk <- function(x, y, ...) {
|
||||||
x
|
NA_disk_[0]
|
||||||
|
}
|
||||||
|
vec_cast.disk.disk <- function(x, to, ...) {
|
||||||
|
as.disk(x)
|
||||||
}
|
}
|
||||||
vec_cast.integer.disk <- function(x, to, ...) {
|
vec_cast.integer.disk <- function(x, to, ...) {
|
||||||
unclass(x)
|
unclass(x)
|
||||||
|
@ -136,11 +139,11 @@ vec_cast.disk.character <- function(x, to, ...) {
|
||||||
# S3: mic ----
|
# S3: mic ----
|
||||||
vec_ptype2.mic.default <- function (x, y, ..., x_arg = "", y_arg = "") {
|
vec_ptype2.mic.default <- function (x, y, ..., x_arg = "", y_arg = "") {
|
||||||
# this will make sure that currently implemented MIC levels are returned
|
# this will make sure that currently implemented MIC levels are returned
|
||||||
as.mic(x)
|
NA_mic_[0]
|
||||||
}
|
}
|
||||||
vec_ptype2.mic.mic <- function(x, y, ...) {
|
vec_ptype2.mic.mic <- function(x, y, ...) {
|
||||||
# this will make sure that currently implemented MIC levels are returned
|
# this will make sure that currently implemented MIC levels are returned
|
||||||
as.mic(x)
|
NA_mic_[0]
|
||||||
}
|
}
|
||||||
vec_cast.mic.mic <- function(x, to, ...) {
|
vec_cast.mic.mic <- function(x, to, ...) {
|
||||||
# this will make sure that currently implemented MIC levels are returned
|
# this will make sure that currently implemented MIC levels are returned
|
||||||
|
@ -187,6 +190,10 @@ vec_ptype2.sir.sir <- function(x, y, ...) {
|
||||||
vec_ptype2.character.sir <- function(x, y, ...) {
|
vec_ptype2.character.sir <- function(x, y, ...) {
|
||||||
NA_sir_[0]
|
NA_sir_[0]
|
||||||
}
|
}
|
||||||
|
vec_cast.sir.sir <- function(x, to, ...) {
|
||||||
|
# this makes sure that old SIR objects (with S/I/R) are converted to the current structure (S/SDD/I/R/NI)
|
||||||
|
as.sir(x)
|
||||||
|
}
|
||||||
vec_cast.character.sir <- function(x, to, ...) {
|
vec_cast.character.sir <- function(x, to, ...) {
|
||||||
as.character(x)
|
as.character(x)
|
||||||
}
|
}
|
||||||
|
|
11
R/zzz.R
11
R/zzz.R
|
@ -62,13 +62,15 @@ AMR_env$sir_interpretation_history <- data.frame(
|
||||||
mo_user = character(0),
|
mo_user = character(0),
|
||||||
ab = set_clean_class(character(0), c("ab", "character")),
|
ab = set_clean_class(character(0), c("ab", "character")),
|
||||||
mo = set_clean_class(character(0), c("mo", "character")),
|
mo = set_clean_class(character(0), c("mo", "character")),
|
||||||
|
method = character(0),
|
||||||
input = double(0),
|
input = double(0),
|
||||||
outcome = NA_sir_[0],
|
outcome = NA_sir_[0],
|
||||||
method = character(0),
|
|
||||||
breakpoint_S_R = character(0),
|
|
||||||
guideline = character(0),
|
|
||||||
host = character(0),
|
host = character(0),
|
||||||
|
notes = character(0),
|
||||||
|
guideline = character(0),
|
||||||
ref_table = character(0),
|
ref_table = character(0),
|
||||||
|
uti = logical(0),
|
||||||
|
breakpoint_S_R = character(0),
|
||||||
stringsAsFactors = FALSE
|
stringsAsFactors = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -95,6 +97,7 @@ AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %o
|
||||||
s3_register("pillar::pillar_shaft", "sir")
|
s3_register("pillar::pillar_shaft", "sir")
|
||||||
s3_register("pillar::pillar_shaft", "mic")
|
s3_register("pillar::pillar_shaft", "mic")
|
||||||
s3_register("pillar::pillar_shaft", "disk")
|
s3_register("pillar::pillar_shaft", "disk")
|
||||||
|
# no type_sum of disk, that's now in vctrs::vec_ptype_full
|
||||||
s3_register("pillar::type_sum", "ab")
|
s3_register("pillar::type_sum", "ab")
|
||||||
s3_register("pillar::type_sum", "av")
|
s3_register("pillar::type_sum", "av")
|
||||||
s3_register("pillar::type_sum", "mo")
|
s3_register("pillar::type_sum", "mo")
|
||||||
|
@ -153,6 +156,7 @@ AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %o
|
||||||
s3_register("vctrs::vec_ptype_abbr", "disk")
|
s3_register("vctrs::vec_ptype_abbr", "disk")
|
||||||
s3_register("vctrs::vec_ptype2", "disk.default")
|
s3_register("vctrs::vec_ptype2", "disk.default")
|
||||||
s3_register("vctrs::vec_ptype2", "disk.disk")
|
s3_register("vctrs::vec_ptype2", "disk.disk")
|
||||||
|
s3_register("vctrs::vec_cast", "disk.disk")
|
||||||
s3_register("vctrs::vec_cast", "integer.disk")
|
s3_register("vctrs::vec_cast", "integer.disk")
|
||||||
s3_register("vctrs::vec_cast", "disk.integer")
|
s3_register("vctrs::vec_cast", "disk.integer")
|
||||||
s3_register("vctrs::vec_cast", "double.disk")
|
s3_register("vctrs::vec_cast", "double.disk")
|
||||||
|
@ -179,6 +183,7 @@ AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %o
|
||||||
s3_register("vctrs::vec_ptype2", "character.sir")
|
s3_register("vctrs::vec_ptype2", "character.sir")
|
||||||
s3_register("vctrs::vec_cast", "character.sir")
|
s3_register("vctrs::vec_cast", "character.sir")
|
||||||
s3_register("vctrs::vec_cast", "sir.character")
|
s3_register("vctrs::vec_cast", "sir.character")
|
||||||
|
s3_register("vctrs::vec_cast", "sir.sir")
|
||||||
|
|
||||||
# if mo source exists, fire it up (see mo_source())
|
# if mo source exists, fire it up (see mo_source())
|
||||||
if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {
|
if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {
|
||||||
|
|
Binary file not shown.
|
@ -185,59 +185,31 @@ All data sets in this \code{AMR} package (about microorganisms, antibiotics, SIR
|
||||||
example_isolates
|
example_isolates
|
||||||
|
|
||||||
|
|
||||||
# Examples sections below are split into 'base R', 'dplyr', and 'data.table':
|
# Examples sections below are split into 'dplyr', 'base R', and 'data.table':
|
||||||
|
|
||||||
|
|
||||||
# base R ------------------------------------------------------------------
|
|
||||||
|
|
||||||
# select columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
|
||||||
example_isolates[, carbapenems()]
|
|
||||||
|
|
||||||
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
|
|
||||||
example_isolates[, c("mo", aminoglycosides())]
|
|
||||||
|
|
||||||
# select only antibiotic columns with DDDs for oral treatment
|
|
||||||
example_isolates[, administrable_per_os()]
|
|
||||||
|
|
||||||
# filter using any() or all()
|
|
||||||
example_isolates[any(carbapenems() == "R"), ]
|
|
||||||
subset(example_isolates, any(carbapenems() == "R"))
|
|
||||||
|
|
||||||
# filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
|
|
||||||
example_isolates[any(carbapenems()), ]
|
|
||||||
example_isolates[all(carbapenems()), ]
|
|
||||||
|
|
||||||
# filter with multiple antibiotic selectors using c()
|
|
||||||
example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
|
|
||||||
|
|
||||||
# filter + select in one go: get penicillins in carbapenem-resistant strains
|
|
||||||
example_isolates[any(carbapenems() == "R"), penicillins()]
|
|
||||||
|
|
||||||
# You can combine selectors with '&' to be more specific. For example,
|
|
||||||
# penicillins() would select benzylpenicillin ('peni G') and
|
|
||||||
# administrable_per_os() would select erythromycin. Yet, when combined these
|
|
||||||
# drugs are both omitted since benzylpenicillin is not administrable per os
|
|
||||||
# and erythromycin is not a penicillin:
|
|
||||||
example_isolates[, penicillins() & administrable_per_os()]
|
|
||||||
|
|
||||||
# ab_selector() applies a filter in the `antibiotics` data set and is thus
|
|
||||||
# very flexible. For instance, to select antibiotic columns with an oral DDD
|
|
||||||
# of at least 1 gram:
|
|
||||||
example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
|
|
||||||
|
|
||||||
\donttest{
|
\donttest{
|
||||||
# dplyr -------------------------------------------------------------------
|
# dplyr -------------------------------------------------------------------
|
||||||
|
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
tibble(kefzol = random_sir(5)) \%>\%
|
. example_isolates \%>\% select(carbapenems())
|
||||||
select(cephalosporins())
|
}
|
||||||
|
|
||||||
|
if (require("dplyr")) {
|
||||||
|
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
|
||||||
|
example_isolates \%>\% select(mo, aminoglycosides())
|
||||||
|
}
|
||||||
|
|
||||||
|
if (require("dplyr")) {
|
||||||
|
# select only antibiotic columns with DDDs for oral treatment
|
||||||
|
. example_isolates \%>\% select(administrable_per_os())
|
||||||
}
|
}
|
||||||
|
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
# get AMR for all aminoglycosides e.g., per ward:
|
# get AMR for all aminoglycosides e.g., per ward:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
group_by(ward) \%>\%
|
group_by(ward) \%>\%
|
||||||
summarise(across(aminoglycosides(), resistance))
|
summarise(across(aminoglycosides(),
|
||||||
|
resistance))
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
# You can combine selectors with '&' to be more specific:
|
# You can combine selectors with '&' to be more specific:
|
||||||
|
@ -249,7 +221,8 @@ if (require("dplyr")) {
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
|
filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
|
||||||
group_by(ward) \%>\%
|
group_by(ward) \%>\%
|
||||||
summarise(across(not_intrinsic_resistant(), resistance))
|
summarise_at(not_intrinsic_resistant(),
|
||||||
|
resistance)
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
# get susceptibility for antibiotics whose name contains "trim":
|
# get susceptibility for antibiotics whose name contains "trim":
|
||||||
|
@ -315,6 +288,44 @@ if (require("dplyr")) {
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# base R ------------------------------------------------------------------
|
||||||
|
|
||||||
|
# select columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||||
|
example_isolates[, carbapenems()]
|
||||||
|
|
||||||
|
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
|
||||||
|
example_isolates[, c("mo", aminoglycosides())]
|
||||||
|
|
||||||
|
# select only antibiotic columns with DDDs for oral treatment
|
||||||
|
example_isolates[, administrable_per_os()]
|
||||||
|
|
||||||
|
# filter using any() or all()
|
||||||
|
example_isolates[any(carbapenems() == "R"), ]
|
||||||
|
subset(example_isolates, any(carbapenems() == "R"))
|
||||||
|
|
||||||
|
# filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
|
||||||
|
example_isolates[any(carbapenems()), ]
|
||||||
|
example_isolates[all(carbapenems()), ]
|
||||||
|
|
||||||
|
# filter with multiple antibiotic selectors using c()
|
||||||
|
example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
|
||||||
|
|
||||||
|
# filter + select in one go: get penicillins in carbapenem-resistant strains
|
||||||
|
example_isolates[any(carbapenems() == "R"), penicillins()]
|
||||||
|
|
||||||
|
# You can combine selectors with '&' to be more specific. For example,
|
||||||
|
# penicillins() would select benzylpenicillin ('peni G') and
|
||||||
|
# administrable_per_os() would select erythromycin. Yet, when combined these
|
||||||
|
# drugs are both omitted since benzylpenicillin is not administrable per os
|
||||||
|
# and erythromycin is not a penicillin:
|
||||||
|
example_isolates[, penicillins() & administrable_per_os()]
|
||||||
|
|
||||||
|
# ab_selector() applies a filter in the `antibiotics` data set and is thus
|
||||||
|
# very flexible. For instance, to select antibiotic columns with an oral DDD
|
||||||
|
# of at least 1 gram:
|
||||||
|
example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
|
||||||
|
|
||||||
|
|
||||||
# data.table --------------------------------------------------------------
|
# data.table --------------------------------------------------------------
|
||||||
|
|
||||||
# data.table is supported as well, just use it in the same way as with
|
# data.table is supported as well, just use it in the same way as with
|
||||||
|
|
|
@ -251,6 +251,51 @@ summary(example_isolates) # see all SIR results at a glance
|
||||||
|
|
||||||
# For INTERPRETING disk diffusion and MIC values -----------------------
|
# For INTERPRETING disk diffusion and MIC values -----------------------
|
||||||
|
|
||||||
|
\donttest{
|
||||||
|
## Using dplyr -------------------------------------------------
|
||||||
|
if (require("dplyr")) {
|
||||||
|
# approaches that all work without additional arguments:
|
||||||
|
df \%>\% mutate_if(is.mic, as.sir)
|
||||||
|
df \%>\% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
|
||||||
|
df \%>\% mutate(across(where(is.mic), as.sir))
|
||||||
|
df \%>\% mutate_at(vars(AMP:TOB), as.sir)
|
||||||
|
df \%>\% mutate(across(AMP:TOB, as.sir))
|
||||||
|
|
||||||
|
# approaches that all work with additional arguments:
|
||||||
|
df \%>\% mutate_if(is.mic, as.sir, mo = "column1", guideline = "CLSI")
|
||||||
|
df \%>\% mutate(across(where(is.mic),
|
||||||
|
function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
|
||||||
|
df \%>\% mutate_at(vars(AMP:TOB), as.sir, mo = "column1", guideline = "CLSI")
|
||||||
|
df \%>\% mutate(across(AMP:TOB,
|
||||||
|
function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
|
||||||
|
|
||||||
|
# for veterinary breakpoints, add 'host':
|
||||||
|
df \%>\% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "species_column")
|
||||||
|
df \%>\% mutate_if(is.mic, as.sir, guideline = "CLSI", host = "horse")
|
||||||
|
df \%>\% mutate(across(where(is.mic),
|
||||||
|
function(x) as.sir(x, guideline = "CLSI", host = "species_column")))
|
||||||
|
df \%>\% mutate_at(vars(AMP:TOB), as.sir, guideline = "CLSI", host = "species_column")
|
||||||
|
df \%>\% mutate(across(AMP:TOB,
|
||||||
|
function(x) as.sir(x, mo = "column1", guideline = "CLSI")))
|
||||||
|
|
||||||
|
# to include information about urinary tract infections (UTI)
|
||||||
|
data.frame(mo = "E. coli",
|
||||||
|
nitrofuratoin = c("<= 2", 32),
|
||||||
|
from_the_bladder = c(TRUE, FALSE)) \%>\%
|
||||||
|
as.sir(uti = "from_the_bladder")
|
||||||
|
|
||||||
|
data.frame(mo = "E. coli",
|
||||||
|
nitrofuratoin = c("<= 2", 32),
|
||||||
|
specimen = c("urine", "blood")) \%>\%
|
||||||
|
as.sir() # automatically determines urine isolates
|
||||||
|
|
||||||
|
df \%>\%
|
||||||
|
mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
## Using base R ------------------------------------------------
|
||||||
|
|
||||||
# a whole data set, even with combined MIC values and disk zones
|
# a whole data set, even with combined MIC values and disk zones
|
||||||
df <- data.frame(
|
df <- data.frame(
|
||||||
microorganism = "Escherichia coli",
|
microorganism = "Escherichia coli",
|
||||||
|
@ -280,36 +325,6 @@ as.sir(
|
||||||
guideline = "EUCAST"
|
guideline = "EUCAST"
|
||||||
)
|
)
|
||||||
|
|
||||||
\donttest{
|
|
||||||
# the dplyr way
|
|
||||||
if (require("dplyr")) {
|
|
||||||
df \%>\% mutate_if(is.mic, as.sir)
|
|
||||||
df \%>\% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
|
|
||||||
df \%>\% mutate(across(where(is.mic), as.sir))
|
|
||||||
df \%>\% mutate_at(vars(AMP:TOB), as.sir)
|
|
||||||
df \%>\% mutate(across(AMP:TOB, as.sir))
|
|
||||||
|
|
||||||
df \%>\%
|
|
||||||
mutate_at(vars(AMP:TOB), as.sir, mo = "microorganism")
|
|
||||||
|
|
||||||
# to include information about urinary tract infections (UTI)
|
|
||||||
data.frame(
|
|
||||||
mo = "E. coli",
|
|
||||||
NIT = c("<= 2", 32),
|
|
||||||
from_the_bladder = c(TRUE, FALSE)
|
|
||||||
) \%>\%
|
|
||||||
as.sir(uti = "from_the_bladder")
|
|
||||||
|
|
||||||
data.frame(
|
|
||||||
mo = "E. coli",
|
|
||||||
NIT = c("<= 2", 32),
|
|
||||||
specimen = c("urine", "blood")
|
|
||||||
) \%>\%
|
|
||||||
as.sir() # automatically determines urine isolates
|
|
||||||
|
|
||||||
df \%>\%
|
|
||||||
mutate_at(vars(AMP:TOB), as.sir, mo = "E. coli", uti = TRUE)
|
|
||||||
}
|
|
||||||
|
|
||||||
# For CLEANING existing SIR values ------------------------------------
|
# For CLEANING existing SIR values ------------------------------------
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue