mirror of
https://github.com/msberends/AMR.git
synced 2024-12-24 19:26:12 +01:00
remove warnings from unit tests
This commit is contained in:
parent
fed3b6440f
commit
85e2fbe4a3
@ -1,5 +1,5 @@
|
||||
Package: AMR
|
||||
Version: 1.8.2.9022
|
||||
Version: 1.8.2.9023
|
||||
Date: 2022-10-19
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
|
||||
2
NEWS.md
2
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 1.8.2.9022
|
||||
# AMR 1.8.2.9023
|
||||
|
||||
This version will eventually become v2.0! We're happy to reach a new major milestone soon!
|
||||
|
||||
|
||||
@ -226,7 +226,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
# -- mo
|
||||
if (type == "mo") {
|
||||
if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) {
|
||||
# take first <mo> column
|
||||
# take first 'mo' column
|
||||
found <- colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)]
|
||||
} else if ("mo" %in% colnames_formatted &&
|
||||
suppressWarnings(all(x$mo %in% c(NA, AMR::microorganisms$mo)))) {
|
||||
@ -664,7 +664,7 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca
|
||||
return(paste0(quotes, v, quotes))
|
||||
}
|
||||
if (identical(v, c("I", "R", "S"))) {
|
||||
# class <rsi> should be sorted like this
|
||||
# class 'rsi' should be sorted like this
|
||||
v <- c("R", "S", "I")
|
||||
}
|
||||
# all commas except for last item, so will become '"val1", "val2", "val3" or "val4"'
|
||||
@ -1434,7 +1434,7 @@ s3_register <- function(generic, class, method = NULL) {
|
||||
# see here for the full list: https://github.com/r-lib/backports
|
||||
if (getRversion() < "3.1.0") {
|
||||
# R-3.0 does not contain these functions, set them here to prevent installation failure
|
||||
# (required for extension of the <mic> class)
|
||||
# (required for extension of the 'mic' class)
|
||||
cospi <- function(...) 1
|
||||
sinpi <- function(...) 1
|
||||
tanpi <- function(...) 1
|
||||
|
||||
7
R/ab.R
7
R/ab.R
@ -84,12 +84,13 @@
|
||||
#' # they use as.ab() internally:
|
||||
#' ab_name("J01FA01") # "Erythromycin"
|
||||
#' ab_name("eryt") # "Erythromycin"
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#'
|
||||
#' # you can quickly rename <rsi> columns using dplyr >= 1.0.0:
|
||||
#' # you can quickly rename 'rsi' columns using set_ab_names() with dplyr:
|
||||
#' example_isolates %>%
|
||||
#' rename_with(as.ab, where(is.rsi))
|
||||
#' set_ab_names(where(is.rsi), property = "atc")
|
||||
#' }
|
||||
#' }
|
||||
as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
@ -548,7 +549,7 @@ type_sum.ab <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.ab <- function(x, ...) {
|
||||
cat("Class <ab>\n")
|
||||
cat("Class 'ab'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
|
||||
@ -453,7 +453,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
|
||||
|
||||
ab_validate <- function(x, property, ...) {
|
||||
if (tryCatch(all(x[!is.na(x)] %in% AMR_env$AB_lookup$ab), error = function(e) FALSE)) {
|
||||
# special case for ab_* functions where class is already <ab>
|
||||
# special case for ab_* functions where class is already 'ab'
|
||||
x <- AMR_env$AB_lookup[match(x, AMR_env$AB_lookup$ab), property, drop = TRUE]
|
||||
} else {
|
||||
# try to catch an error when inputting an invalid argument
|
||||
|
||||
@ -32,7 +32,7 @@
|
||||
#' These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group, without the need to define the columns or antibiotic abbreviations. In short, if you have a column name that resembles an antimicrobial agent, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
|
||||
#' @param ab_class an antimicrobial class or a part of it, such as `"carba"` and `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
|
||||
#' @param filter an [expression] to be evaluated in the [antibiotics] data set, such as `name %like% "trim"`
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only columns of class `<rsi>` must be selected (defaults to `FALSE`), see [as.rsi()]
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only columns of class `rsi` must be selected (defaults to `FALSE`), see [as.rsi()]
|
||||
#' @param only_treatable a [logical] to indicate whether agents that are only for laboratory tests should be excluded (defaults to `TRUE`), such as gentamicin-high (`GEH`) and imipenem/EDTA (`IPE`)
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details
|
||||
@ -575,7 +575,7 @@ ab_select_exec <- function(function_name,
|
||||
} else if (isTRUE(function_name == "antimycobacterials")) {
|
||||
abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antimycobacterials")]
|
||||
} else {
|
||||
# their upper case equivalent are vectors with class <ab>, created in data-raw/_pre_commit_hook.R
|
||||
# their upper case equivalent are vectors with class 'ab', created in data-raw/_pre_commit_hook.R
|
||||
# carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
|
||||
abx <- get(paste0("AB_", toupper(function_name)), envir = asNamespace("AMR"))
|
||||
# manually added codes from add_custom_antimicrobials() must also be supported
|
||||
|
||||
@ -253,20 +253,22 @@ print.custom_eucast_rules <- function(x, ...) {
|
||||
}
|
||||
|
||||
format_custom_query_rule <- function(query, colours = has_colour()) {
|
||||
query <- gsub(" & ", font_black(font_bold(" and ")), query, fixed = TRUE)
|
||||
query <- gsub(" | ", font_black(" or "), query, fixed = TRUE)
|
||||
query <- gsub(" + ", font_black(" plus "), query, fixed = TRUE)
|
||||
query <- gsub(" - ", font_black(" minus "), query, fixed = TRUE)
|
||||
query <- gsub(" / ", font_black(" divided by "), query, fixed = TRUE)
|
||||
query <- gsub(" * ", font_black(" times "), query, fixed = TRUE)
|
||||
query <- gsub(" == ", font_black(" is "), query, fixed = TRUE)
|
||||
query <- gsub(" > ", font_black(" is higher than "), query, fixed = TRUE)
|
||||
query <- gsub(" < ", font_black(" is lower than "), query, fixed = TRUE)
|
||||
query <- gsub(" >= ", font_black(" is higher than or equal to "), query, fixed = TRUE)
|
||||
query <- gsub(" <= ", font_black(" is lower than or equal to "), query, fixed = TRUE)
|
||||
query <- gsub(" ^ ", font_black(" to the power of "), query, fixed = TRUE)
|
||||
query <- gsub(" %in% ", font_black(" is one of "), query, fixed = TRUE)
|
||||
query <- gsub(" %like% ", font_black(" resembles "), query, fixed = TRUE)
|
||||
# font_black() is very expensive in RStudio because it checks if the theme is dark, so do it once:
|
||||
txt <- font_black("{text}")
|
||||
query <- gsub(" & ", sub("{text}", font_bold(" and "), txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" | ", sub("{text}", " or ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" + ", sub("{text}", " plus ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" - ", sub("{text}", " minus ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" / ", sub("{text}", " divided by ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" * ", sub("{text}", " times ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" == ", sub("{text}", " is ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" > ", sub("{text}", " is higher than ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" < ", sub("{text}", " is lower than ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" >= ", sub("{text}", " is higher than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" <= ", sub("{text}", " is lower than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" ^ ", sub("{text}", " to the power of ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" %in% ", sub("{text}", " is one of ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" %like% ", sub("{text}", " resembles ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
if (colours == TRUE) {
|
||||
query <- gsub('"R"', font_red_bg(" R "), query, fixed = TRUE)
|
||||
query <- gsub('"S"', font_green_bg(" S "), query, fixed = TRUE)
|
||||
|
||||
4
R/disk.R
4
R/disk.R
@ -139,7 +139,7 @@ all_valid_disks <- function(x) {
|
||||
}
|
||||
|
||||
#' @rdname as.disk
|
||||
#' @details `NA_disk_` is a missing value of the new `<disk>` class.
|
||||
#' @details `NA_disk_` is a missing value of the new `disk` class.
|
||||
#' @export
|
||||
NA_disk_ <- set_clean_class(as.integer(NA_real_),
|
||||
new_class = c("disk", "integer")
|
||||
@ -167,7 +167,7 @@ type_sum.disk <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.disk <- function(x, ...) {
|
||||
cat("Class <disk>\n")
|
||||
cat("Class 'disk'\n")
|
||||
print(as.integer(x), quote = FALSE)
|
||||
}
|
||||
|
||||
|
||||
@ -69,7 +69,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' @param ... column name of an antibiotic, see section *Antibiotics* below
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
|
||||
#' @param administration route of administration, either `r vector_or(dosage$administration)`
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `rsi` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param custom_rules custom rules to apply, created with [custom_eucast_rules()]
|
||||
#' @inheritParams first_isolate
|
||||
#' @details
|
||||
@ -1023,7 +1023,7 @@ eucast_rules <- function(x,
|
||||
warn_lacking_rsi_class <- warn_lacking_rsi_class[order(colnames(x.bak))]
|
||||
warn_lacking_rsi_class <- warn_lacking_rsi_class[!is.na(warn_lacking_rsi_class)]
|
||||
warning_(
|
||||
"in `eucast_rules()`: not all columns with antimicrobial results are of class <rsi>. Transform them on beforehand, with e.g.:\n",
|
||||
"in `eucast_rules()`: not all columns with antimicrobial results are of class 'rsi'. Transform them on beforehand, with e.g.:\n",
|
||||
" - ", x_deparsed, " %>% as.rsi(", ifelse(length(warn_lacking_rsi_class) == 1,
|
||||
warn_lacking_rsi_class,
|
||||
paste0(warn_lacking_rsi_class[1], ":", warn_lacking_rsi_class[length(warn_lacking_rsi_class)])
|
||||
|
||||
@ -48,7 +48,7 @@
|
||||
#' @param points_threshold minimum number of points to require before differences in the antibiogram will lead to inclusion of an isolate when `type = "points"`, see *Details*
|
||||
#' @param info a [logical] to indicate info should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param include_unknown a [logical] to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
|
||||
#' @param include_untested_rsi a [logical] to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `<rsi>` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
|
||||
#' @param include_untested_rsi a [logical] to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `rsi` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
|
||||
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], otherwise arguments passed on to [key_antimicrobials()] (such as `universal`, `gram_negative`, `gram_positive`)
|
||||
#' @details
|
||||
#' To conduct epidemiological analyses on antimicrobial resistance data, only so-called first isolates should be included to prevent overestimation and underestimation of antimicrobial resistance. Different methods can be used to do so, see below.
|
||||
|
||||
@ -33,7 +33,7 @@
|
||||
#' @param x a [data.frame]
|
||||
#' @param search_string a text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x`
|
||||
#' @param verbose a [logical] to indicate whether additional info should be printed
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `rsi` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic.
|
||||
#' @return A column name of `x`, or `NULL` when no result is found.
|
||||
#' @export
|
||||
@ -171,7 +171,7 @@ get_column_abx <- function(x,
|
||||
}
|
||||
|
||||
# only check columns that are a valid AB code, ATC code, name, abbreviation or synonym,
|
||||
# or already have the <rsi> class (as.rsi)
|
||||
# or already have the 'rsi' class (as.rsi)
|
||||
# and that they have no more than 50% invalid values
|
||||
vectr_antibiotics <- unlist(AMR_env$AB_lookup$generalised_all)
|
||||
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
|
||||
|
||||
@ -37,7 +37,7 @@
|
||||
#' @param gram_negative names of antibiotic agents for **Gram-positives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
|
||||
#' @param gram_positive names of antibiotic agents for **Gram-negatives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
|
||||
#' @param antifungal names of antifungal agents for **fungi**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only columns must be included that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param only_rsi_columns a [logical] to indicate whether only columns must be included that were transformed to class `rsi` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
|
||||
#' @param ... ignored, only in place to allow future extensions
|
||||
#' @details
|
||||
#' The [key_antimicrobials()] and [all_antimicrobials()] functions are context-aware. This means that the `x` argument can be left blank if used inside a [data.frame] call, see *Examples*.
|
||||
|
||||
4
R/mdro.R
4
R/mdro.R
@ -1941,9 +1941,9 @@ print.custom_mdro_guideline <- function(x, ...) {
|
||||
cat(" ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
|
||||
cat("\nUnmatched rows will return ", font_red("NA"), ".\n", sep = "")
|
||||
if (isTRUE(attributes(x)$as_factor)) {
|
||||
cat("Results will be of class <factor>, with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "")
|
||||
cat("Results will be of class 'factor', with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "")
|
||||
} else {
|
||||
cat("Results will be of class <character>.\n")
|
||||
cat("Results will be of class 'character'.\n")
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
12
R/mic.R
12
R/mic.R
@ -84,7 +84,7 @@ valid_mic_levels <- c(
|
||||
#' ```
|
||||
#' x <- random_mic(10)
|
||||
#' x
|
||||
#' #> Class <mic>
|
||||
#' #> Class 'mic'
|
||||
#' #> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||
#'
|
||||
#' is.factor(x)
|
||||
@ -101,7 +101,7 @@ valid_mic_levels <- c(
|
||||
#'
|
||||
#' ```
|
||||
#' x[x > 4]
|
||||
#' #> Class <mic>
|
||||
#' #> Class 'mic'
|
||||
#' #> [1] 16 8 8 64 >=128 32 32 16
|
||||
#'
|
||||
#' df <- data.frame(x, hospital = "A")
|
||||
@ -119,7 +119,7 @@ valid_mic_levels <- c(
|
||||
#'
|
||||
#' Using [as.double()] or [as.numeric()] on MIC values will remove the operators and return a numeric vector. Do **not** use [as.integer()] on MIC values as by the \R convention on [factor]s, it will return the index of the factor levels (which is often useless for regular users).
|
||||
#'
|
||||
#' Use [droplevels()] to drop unused levels. At default, it will return a plain factor. Use `droplevels(..., as.mic = TRUE)` to maintain the `<mic>` class.
|
||||
#' Use [droplevels()] to drop unused levels. At default, it will return a plain factor. Use `droplevels(..., as.mic = TRUE)` to maintain the `mic` class.
|
||||
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a [numeric] value.
|
||||
#' @aliases mic
|
||||
#' @export
|
||||
@ -253,7 +253,7 @@ all_valid_mics <- function(x) {
|
||||
}
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @details `NA_mic_` is a missing value of the new `<mic>` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
|
||||
#' @details `NA_mic_` is a missing value of the new `mic` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
|
||||
#' @format NULL
|
||||
#' @export
|
||||
NA_mic_ <- set_clean_class(factor(NA, levels = valid_mic_levels, ordered = TRUE),
|
||||
@ -282,7 +282,7 @@ as.numeric.mic <- function(x, ...) {
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @method droplevels mic
|
||||
#' @param as.mic a [logical] to indicate whether the `<mic>` class should be kept, defaults to `FALSE`
|
||||
#' @param as.mic a [logical] to indicate whether the `mic` class should be kept, defaults to `FALSE`
|
||||
#' @export
|
||||
droplevels.mic <- function(x, as.mic = FALSE, ...) {
|
||||
x <- droplevels.factor(x, ...)
|
||||
@ -313,7 +313,7 @@ type_sum.mic <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.mic <- function(x, ...) {
|
||||
cat("Class <mic>",
|
||||
cat("Class 'mic'",
|
||||
ifelse(length(levels(x)) < length(valid_mic_levels), font_red(" with dropped levels"), ""),
|
||||
"\n",
|
||||
sep = ""
|
||||
|
||||
4
R/mo.R
4
R/mo.R
@ -408,7 +408,7 @@ as.mo <- function(x,
|
||||
}
|
||||
}
|
||||
|
||||
# 'MO_CONS' and 'MO_COPS' are <mo> vectors created in R/_pre_commit_hook.R
|
||||
# 'MO_CONS' and 'MO_COPS' are 'mo' vectors created in R/_pre_commit_hook.R
|
||||
out[out %in% MO_CONS] <- "B_STPHY_CONS"
|
||||
out[out %in% MO_COPS] <- "B_STPHY_COPS"
|
||||
if (Becker == "all") {
|
||||
@ -635,7 +635,7 @@ get_skimmers.mo <- function(column) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.mo <- function(x, print.shortnames = FALSE, ...) {
|
||||
cat("Class <mo>\n")
|
||||
cat("Class 'mo'\n")
|
||||
x_names <- names(x)
|
||||
if (is.null(x_names) & print.shortnames == TRUE) {
|
||||
x_names <- tryCatch(mo_shortname(x, ...), error = function(e) NULL)
|
||||
|
||||
@ -172,7 +172,7 @@
|
||||
#' }
|
||||
mo_name <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_name")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -194,7 +194,7 @@ mo_fullname <- mo_name
|
||||
#' @export
|
||||
mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_shortname")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -235,7 +235,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
||||
#' @export
|
||||
mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_subspecies")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -249,7 +249,7 @@ mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOpt
|
||||
#' @export
|
||||
mo_species <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_species")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -263,7 +263,7 @@ mo_species <- function(x, language = get_AMR_locale(), keep_synonyms = getOption
|
||||
#' @export
|
||||
mo_genus <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_genus")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -277,7 +277,7 @@ mo_genus <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("
|
||||
#' @export
|
||||
mo_family <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_family")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -291,7 +291,7 @@ mo_family <- function(x, language = get_AMR_locale(), keep_synonyms = getOption(
|
||||
#' @export
|
||||
mo_order <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_order")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -305,7 +305,7 @@ mo_order <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("
|
||||
#' @export
|
||||
mo_class <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_class")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -319,7 +319,7 @@ mo_class <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("
|
||||
#' @export
|
||||
mo_phylum <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_phylum")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -333,7 +333,7 @@ mo_phylum <- function(x, language = get_AMR_locale(), keep_synonyms = getOption(
|
||||
#' @export
|
||||
mo_kingdom <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_kingdom")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -351,7 +351,7 @@ mo_domain <- mo_kingdom
|
||||
#' @export
|
||||
mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_type")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -368,7 +368,7 @@ mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
#' @export
|
||||
mo_status <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_status")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -382,7 +382,7 @@ mo_status <- function(x, language = get_AMR_locale(), keep_synonyms = getOption(
|
||||
#' @export
|
||||
mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_gramstain")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -417,7 +417,7 @@ mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
||||
#' @export
|
||||
mo_is_gram_negative <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_is_gram_negative")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -437,7 +437,7 @@ mo_is_gram_negative <- function(x, language = get_AMR_locale(), keep_synonyms =
|
||||
#' @export
|
||||
mo_is_gram_positive <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_is_gram_positive")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -457,7 +457,7 @@ mo_is_gram_positive <- function(x, language = get_AMR_locale(), keep_synonyms =
|
||||
#' @export
|
||||
mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_is_yeast")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -482,7 +482,7 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
||||
#' @export
|
||||
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_is_intrinsic_resistant")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -519,7 +519,7 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_s
|
||||
#' @export
|
||||
mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_snomed")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -533,7 +533,7 @@ mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption(
|
||||
#' @export
|
||||
mo_ref <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_ref")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -547,7 +547,7 @@ mo_ref <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AM
|
||||
#' @export
|
||||
mo_authors <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_authors")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -564,7 +564,7 @@ mo_authors <- function(x, language = get_AMR_locale(), keep_synonyms = getOption
|
||||
#' @export
|
||||
mo_year <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_year")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -581,7 +581,7 @@ mo_year <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
#' @export
|
||||
mo_lpsn <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_lpsn")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -595,7 +595,7 @@ mo_lpsn <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
#' @export
|
||||
mo_gbif <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_gbif")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -609,7 +609,7 @@ mo_gbif <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
#' @export
|
||||
mo_rank <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_rank")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -623,7 +623,7 @@ mo_rank <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
#' @export
|
||||
mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_taxonomy")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -652,7 +652,7 @@ mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
||||
#' @export
|
||||
mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_synonyms")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -698,7 +698,7 @@ mo_current <- function(x, language = get_AMR_locale(), ...) {
|
||||
#' @export
|
||||
mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_info")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -736,7 +736,7 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
#' @export
|
||||
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_url")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
@ -775,7 +775,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms =
|
||||
#' @export
|
||||
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an <mo> column
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_property")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
|
||||
@ -75,7 +75,7 @@
|
||||
#'
|
||||
#' ```
|
||||
#' as.mo("lab_mo_ecoli")
|
||||
#' #> Class <mo>
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI
|
||||
#'
|
||||
#' mo_genus("lab_mo_kpneumoniae")
|
||||
@ -85,7 +85,7 @@
|
||||
#' as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
||||
#' #> NOTE: Translation to one microorganism was guessed with uncertainty.
|
||||
#' #> Use mo_uncertainties() to review it.
|
||||
#' #> Class <mo>
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
||||
#' ```
|
||||
#'
|
||||
@ -108,7 +108,7 @@
|
||||
#' #> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#' #> "Organisation XYZ" and "mo"
|
||||
#' #> Class <mo>
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI
|
||||
#'
|
||||
#' mo_genus("lab_Staph_aureus")
|
||||
|
||||
@ -38,7 +38,7 @@
|
||||
#' @details The base \R function [sample()] is used for generating values.
|
||||
#'
|
||||
#' Generated values are based on the EUCAST `r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))` guideline as implemented in the [rsi_translation] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` argument.
|
||||
#' @return class `<mic>` for [random_mic()] (see [as.mic()]) and class `<disk>` for [random_disk()] (see [as.disk()])
|
||||
#' @return class `mic` for [random_mic()] (see [as.mic()]) and class `disk` for [random_disk()] (see [as.disk()])
|
||||
#' @name random
|
||||
#' @rdname random
|
||||
#' @export
|
||||
|
||||
12
R/rsi.R
12
R/rsi.R
@ -82,7 +82,7 @@
|
||||
#'
|
||||
#' ### Other
|
||||
#'
|
||||
#' The function [is.rsi()] detects if the input contains class `<rsi>`. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#' The function [is.rsi()] detects if the input contains class `rsi`. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#'
|
||||
#' The function [is.rsi.eligible()] returns `TRUE` when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#' @section Interpretation of R and S/I:
|
||||
@ -96,7 +96,7 @@
|
||||
#' A microorganism is categorised as *Susceptible, Increased exposure* when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection.
|
||||
#'
|
||||
#' This AMR package honours this (new) insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates.
|
||||
#' @return Ordered [factor] with new class `<rsi>`
|
||||
#' @return Ordered [factor] with new class `rsi`
|
||||
#' @aliases rsi
|
||||
#' @export
|
||||
#' @seealso [as.mic()], [as.disk()], [as.mo()]
|
||||
@ -198,7 +198,7 @@ as.rsi <- function(x, ...) {
|
||||
}
|
||||
|
||||
#' @rdname as.rsi
|
||||
#' @details `NA_rsi_` is a missing value of the new `<rsi>` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
|
||||
#' @details `NA_rsi_` is a missing value of the new `rsi` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
|
||||
#' @export
|
||||
NA_rsi_ <- set_clean_class(factor(NA, levels = c("S", "I", "R"), ordered = TRUE),
|
||||
new_class = c("rsi", "ordered", "factor")
|
||||
@ -609,7 +609,7 @@ as.rsi.data.frame <- function(x,
|
||||
} else if (!is.rsi(x.bak[, ab_cols[i], drop = TRUE])) {
|
||||
show_message <- TRUE
|
||||
# only print message if class not already set
|
||||
message_("=> Assigning class <rsi> to already clean column '", font_bold(ab), "' (",
|
||||
message_("=> Assigning class 'rsi' to already clean column '", font_bold(ab), "' (",
|
||||
ifelse(ab_coerced != toupper(ab), paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE), ")... ",
|
||||
appendLF = FALSE,
|
||||
@ -702,7 +702,7 @@ as_rsi_method <- function(method_short,
|
||||
)
|
||||
}
|
||||
if (is.null(mo)) {
|
||||
stop_("No information was supplied about the microorganisms (missing argument `mo` and no column of class <mo> found). See ?as.rsi.\n\n",
|
||||
stop_("No information was supplied about the microorganisms (missing argument `mo` and no column of class 'mo' found). See ?as.rsi.\n\n",
|
||||
"To transform certain columns with e.g. mutate(), use `data %>% mutate(across(..., as.rsi, mo = x))`, where x is your column with microorganisms.\n",
|
||||
"To tranform all ", method_long, " in a data set, use `data %>% as.rsi()` or `data %>% mutate(across(where(is.", method_short, "), as.rsi))`.",
|
||||
call = FALSE
|
||||
@ -1086,7 +1086,7 @@ get_skimmers.rsi <- function(column) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.rsi <- function(x, ...) {
|
||||
cat("Class <rsi>\n")
|
||||
cat("Class 'rsi'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
|
||||
@ -120,7 +120,7 @@ rsi_calc <- function(...,
|
||||
if (is.data.frame(x)) {
|
||||
rsi_integrity_check <- character(0)
|
||||
for (i in seq_len(ncol(x))) {
|
||||
# check integrity of columns: force <rsi> class
|
||||
# check integrity of columns: force 'rsi' class
|
||||
if (!is.rsi(x[, i, drop = TRUE])) {
|
||||
rsi_integrity_check <- c(rsi_integrity_check, as.character(x[, i, drop = TRUE]))
|
||||
x[, i] <- suppressWarnings(as.rsi(x[, i, drop = TRUE])) # warning will be given later
|
||||
@ -160,7 +160,7 @@ rsi_calc <- function(...,
|
||||
|
||||
if (print_warning == TRUE) {
|
||||
if (message_not_thrown_before("rsi_calc")) {
|
||||
warning_("Increase speed by transforming to class <rsi> on beforehand:\n",
|
||||
warning_("Increase speed by transforming to class 'rsi' on beforehand:\n",
|
||||
" your_data %>% mutate_if(is.rsi.eligible, as.rsi)\n",
|
||||
" your_data %>% mutate(across(where(is.rsi.eligible), as.rsi))",
|
||||
call = FALSE
|
||||
@ -344,7 +344,7 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
} else if (isTRUE(combine_IR)) {
|
||||
out$interpretation <- factor(out$interpretation, levels = c("S", "IR"), ordered = TRUE)
|
||||
} else {
|
||||
# don't use as.rsi() here, as it would add the class <rsi> and we would like
|
||||
# don't use as.rsi() here, as it would add the class 'rsi' and we would like
|
||||
# the same data structure as output, regardless of input
|
||||
out$interpretation <- factor(out$interpretation, levels = c("S", "I", "R"), ordered = TRUE)
|
||||
}
|
||||
|
||||
@ -281,6 +281,6 @@ expect_warning(mdro(example_isolates,
|
||||
|
||||
# print groups
|
||||
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
|
||||
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), info = TRUE))
|
||||
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), info = TRUE, pct_required_classes = 0))
|
||||
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), guideline = custom, info = TRUE))
|
||||
}
|
||||
|
||||
@ -297,7 +297,7 @@ expect_equal(as.character(as.mo("con")), "UNKNOWN")
|
||||
expect_equal(as.character(as.mo("xxx")), NA_character_)
|
||||
expect_equal(as.character(as.mo(c("xxx", "con", "eco"))), c(NA_character_, "UNKNOWN", "B_ESCHR_COLI"))
|
||||
expect_equal(
|
||||
as.character(as.mo(c("other", "none", "unknown"))),
|
||||
as.character(suppressWarnings(as.mo(c("other", "none", "unknown")))),
|
||||
rep("UNKNOWN", 3)
|
||||
)
|
||||
|
||||
|
||||
@ -84,9 +84,10 @@ for (l in AMR:::LANGUAGES_SUPPORTED[-1]) {
|
||||
expect_false(mo_gramstain("Escherichia coli", language = l) == gr, info = paste("Gram-stain in language", l))
|
||||
}
|
||||
|
||||
# test languages
|
||||
expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN"))
|
||||
dutch <- mo_name(microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi")], language = "nl", keep_synonyms = TRUE) # should be transformable to English again
|
||||
expect_identical(mo_name(dutch, language = NULL, keep_synonyms = TRUE),
|
||||
dutch <- suppressWarnings(mo_name(microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi")], language = "nl", keep_synonyms = TRUE)) # should be transformable to English again
|
||||
expect_identical(suppressWarnings(mo_name(dutch, language = NULL, keep_synonyms = TRUE)),
|
||||
microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi")]) # gigantic test - will run ALL names
|
||||
|
||||
# manual property function
|
||||
|
||||
@ -102,7 +102,7 @@ not_intrinsic_resistant(
|
||||
\arguments{
|
||||
\item{ab_class}{an antimicrobial class or a part of it, such as \code{"carba"} and \code{"carbapenems"}. The columns \code{group}, \code{atc_group1} and \code{atc_group2} of the \link{antibiotics} data set will be searched (case-insensitive) for this value.}
|
||||
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only columns of class \verb{<rsi>} must be selected (defaults to \code{FALSE}), see \code{\link[=as.rsi]{as.rsi()}}}
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only columns of class \code{rsi} must be selected (defaults to \code{FALSE}), see \code{\link[=as.rsi]{as.rsi()}}}
|
||||
|
||||
\item{only_treatable}{a \link{logical} to indicate whether agents that are only for laboratory tests should be excluded (defaults to \code{TRUE}), such as gentamicin-high (\code{GEH}) and imipenem/EDTA (\code{IPE})}
|
||||
|
||||
|
||||
@ -89,12 +89,13 @@ ab_atc("seephthriaaksone") # and even this works
|
||||
# they use as.ab() internally:
|
||||
ab_name("J01FA01") # "Erythromycin"
|
||||
ab_name("eryt") # "Erythromycin"
|
||||
|
||||
\donttest{
|
||||
if (require("dplyr")) {
|
||||
|
||||
# you can quickly rename <rsi> columns using dplyr >= 1.0.0:
|
||||
# you can quickly rename 'rsi' columns using set_ab_names() with dplyr:
|
||||
example_isolates \%>\%
|
||||
rename_with(as.ab, where(is.rsi))
|
||||
set_ab_names(where(is.rsi), property = "atc")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -31,7 +31,7 @@ This transforms a vector to a new class \code{\link{disk}}, which is a disk diff
|
||||
\details{
|
||||
Interpret disk values as RSI values with \code{\link[=as.rsi]{as.rsi()}}. It supports guidelines from EUCAST and CLSI.
|
||||
|
||||
\code{NA_disk_} is a missing value of the new \verb{<disk>} class.
|
||||
\code{NA_disk_} is a missing value of the new \code{disk} class.
|
||||
}
|
||||
\examples{
|
||||
# transform existing disk zones to the `disk` class (using base R)
|
||||
|
||||
@ -22,7 +22,7 @@ is.mic(x)
|
||||
|
||||
\item{na.rm}{a \link{logical} indicating whether missing values should be removed}
|
||||
|
||||
\item{as.mic}{a \link{logical} to indicate whether the \verb{<mic>} class should be kept, defaults to \code{FALSE}}
|
||||
\item{as.mic}{a \link{logical} to indicate whether the \code{mic} class should be kept, defaults to \code{FALSE}}
|
||||
|
||||
\item{...}{arguments passed on to methods}
|
||||
}
|
||||
@ -39,7 +39,7 @@ This class for MIC values is a quite a special data type: formally it is an orde
|
||||
|
||||
\if{html}{\out{<div class="sourceCode">}}\preformatted{x <- random_mic(10)
|
||||
x
|
||||
#> Class <mic>
|
||||
#> Class 'mic'
|
||||
#> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||
|
||||
is.factor(x)
|
||||
@ -55,7 +55,7 @@ median(x)
|
||||
This makes it possible to maintain operators that often come with MIC values, such ">=" and "<=", even when filtering using \link{numeric} values in data analysis, e.g.:
|
||||
|
||||
\if{html}{\out{<div class="sourceCode">}}\preformatted{x[x > 4]
|
||||
#> Class <mic>
|
||||
#> Class 'mic'
|
||||
#> [1] 16 8 8 64 >=128 32 32 16
|
||||
|
||||
df <- data.frame(x, hospital = "A")
|
||||
@ -73,9 +73,9 @@ The following \link[=groupGeneric]{generic functions} are implemented for the MI
|
||||
|
||||
Using \code{\link[=as.double]{as.double()}} or \code{\link[=as.numeric]{as.numeric()}} on MIC values will remove the operators and return a numeric vector. Do \strong{not} use \code{\link[=as.integer]{as.integer()}} on MIC values as by the \R convention on \link{factor}s, it will return the index of the factor levels (which is often useless for regular users).
|
||||
|
||||
Use \code{\link[=droplevels]{droplevels()}} to drop unused levels. At default, it will return a plain factor. Use \code{droplevels(..., as.mic = TRUE)} to maintain the \verb{<mic>} class.
|
||||
Use \code{\link[=droplevels]{droplevels()}} to drop unused levels. At default, it will return a plain factor. Use \code{droplevels(..., as.mic = TRUE)} to maintain the \code{mic} class.
|
||||
|
||||
\code{NA_mic_} is a missing value of the new \verb{<mic>} class, analogous to e.g. base \R's \code{\link[base:NA]{NA_character_}}.
|
||||
\code{NA_mic_} is a missing value of the new \code{mic} class, analogous to e.g. base \R's \code{\link[base:NA]{NA_character_}}.
|
||||
}
|
||||
\examples{
|
||||
mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
||||
|
||||
@ -86,7 +86,7 @@ rsi_interpretation_history(clean = FALSE)
|
||||
\item{clean}{a \link{logical} to indicate whether previously stored results should be forgotten after returning the 'logbook' with results}
|
||||
}
|
||||
\value{
|
||||
Ordered \link{factor} with new class \verb{<rsi>}
|
||||
Ordered \link{factor} with new class \code{rsi}
|
||||
}
|
||||
\description{
|
||||
Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing R/SI values. This transforms the input to a new class \code{\link{rsi}}, which is an ordered \link{factor} with levels \verb{S < I < R}.
|
||||
@ -139,12 +139,12 @@ The repository of this package \href{https://github.com/msberends/AMR/blob/main/
|
||||
|
||||
\subsection{Other}{
|
||||
|
||||
The function \code{\link[=is.rsi]{is.rsi()}} detects if the input contains class \verb{<rsi>}. If the input is a \link{data.frame}, it iterates over all columns and returns a \link{logical} vector.
|
||||
The function \code{\link[=is.rsi]{is.rsi()}} detects if the input contains class \code{rsi}. If the input is a \link{data.frame}, it iterates over all columns and returns a \link{logical} vector.
|
||||
|
||||
The function \code{\link[=is.rsi.eligible]{is.rsi.eligible()}} returns \code{TRUE} when a columns contains at most 5\% invalid antimicrobial interpretations (not S and/or I and/or R), and \code{FALSE} otherwise. The threshold of 5\% can be set with the \code{threshold} argument. If the input is a \link{data.frame}, it iterates over all columns and returns a \link{logical} vector.
|
||||
}
|
||||
|
||||
\code{NA_rsi_} is a missing value of the new \verb{<rsi>} class, analogous to e.g. base \R's \code{\link[base:NA]{NA_character_}}.
|
||||
\code{NA_rsi_} is a missing value of the new \code{rsi} class, analogous to e.g. base \R's \code{\link[base:NA]{NA_character_}}.
|
||||
}
|
||||
\section{Interpretation of R and S/I}{
|
||||
|
||||
|
||||
@ -52,7 +52,7 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 11)
|
||||
|
||||
\item{ampc_cephalosporin_resistance}{a \link{character} value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants, defaults to \code{NA}. Currently only works when \code{version_expertrules} is \code{3.2} and higher; these version of '\emph{EUCAST Expert Rules on Enterobacterales}' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three agents. A value of \code{NA} (the default) for this argument will remove results for these three agents, while e.g. a value of \code{"R"} will make the results for these agents resistant. Use \code{NULL} or \code{FALSE} to not alter results for these three agents of AmpC de-repressed cephalosporin-resistant mutants. Using \code{TRUE} is equal to using \code{"R"}. \cr For \emph{EUCAST Expert Rules} v3.2, this rule applies to: \emph{Citrobacter braakii}, \emph{Citrobacter freundii}, \emph{Citrobacter gillenii}, \emph{Citrobacter murliniae}, \emph{Citrobacter rodenticum}, \emph{Citrobacter sedlakii}, \emph{Citrobacter werkmanii}, \emph{Citrobacter youngae}, \emph{Enterobacter}, \emph{Hafnia alvei}, \emph{Klebsiella aerogenes}, \emph{Morganella morganii}, \emph{Providencia} and \emph{Serratia}.}
|
||||
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only antibiotic columns must be detected that were transformed to class \verb{<rsi>} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only antibiotic columns must be detected that were transformed to class \code{rsi} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
|
||||
\item{custom_rules}{custom rules to apply, created with \code{\link[=custom_eucast_rules]{custom_eucast_rules()}}}
|
||||
|
||||
|
||||
@ -82,7 +82,7 @@ filter_first_isolate(
|
||||
|
||||
\item{include_unknown}{a \link{logical} to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code \code{"UNKNOWN"}, which defaults to \code{FALSE}. For WHONET users, this means that all records with organism code \code{"con"} (\emph{contamination}) will be excluded at default. Isolates with a microbial ID of \code{NA} will always be excluded as first isolate.}
|
||||
|
||||
\item{include_untested_rsi}{a \link{logical} to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use \code{include_untested_rsi = FALSE} to always return \code{FALSE} for such rows. This checks the data set for columns of class \verb{<rsi>} and consequently requires transforming columns with antibiotic results using \code{\link[=as.rsi]{as.rsi()}} first.}
|
||||
\item{include_untested_rsi}{a \link{logical} to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use \code{include_untested_rsi = FALSE} to always return \code{FALSE} for such rows. This checks the data set for columns of class \code{rsi} and consequently requires transforming columns with antibiotic results using \code{\link[=as.rsi]{as.rsi()}} first.}
|
||||
|
||||
\item{...}{arguments passed on to \code{\link[=first_isolate]{first_isolate()}} when using \code{\link[=filter_first_isolate]{filter_first_isolate()}}, otherwise arguments passed on to \code{\link[=key_antimicrobials]{key_antimicrobials()}} (such as \code{universal}, \code{gram_negative}, \code{gram_positive})}
|
||||
}
|
||||
|
||||
@ -18,7 +18,7 @@ guess_ab_col(
|
||||
|
||||
\item{verbose}{a \link{logical} to indicate whether additional info should be printed}
|
||||
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only antibiotic columns must be detected that were transformed to class \verb{<rsi>} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only antibiotic columns must be detected that were transformed to class \code{rsi} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
}
|
||||
\value{
|
||||
A column name of \code{x}, or \code{NULL} when no result is found.
|
||||
|
||||
@ -45,7 +45,7 @@ antimicrobials_equal(
|
||||
|
||||
\item{antifungal}{names of antifungal agents for \strong{fungi}, case-insensitive. Set to \code{NULL} to ignore. See \emph{Details} for the default agents.}
|
||||
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only columns must be included that were transformed to class \verb{<rsi>} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only columns must be included that were transformed to class \code{rsi} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
|
||||
\item{...}{ignored, only in place to allow future extensions}
|
||||
|
||||
|
||||
@ -58,7 +58,7 @@ eucast_exceptional_phenotypes(x = NULL, only_rsi_columns = FALSE, ...)
|
||||
|
||||
\item{verbose}{a \link{logical} to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.}
|
||||
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only antibiotic columns must be detected that were transformed to class \verb{<rsi>} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
\item{only_rsi_columns}{a \link{logical} to indicate whether only antibiotic columns must be detected that were transformed to class \code{rsi} (see \code{\link[=as.rsi]{as.rsi()}}) on beforehand (defaults to \code{FALSE})}
|
||||
|
||||
\item{...}{in case of \code{\link[=custom_mdro_guideline]{custom_mdro_guideline()}}: a set of rules, see section \emph{Using Custom Guidelines} below. Otherwise: column name of an antibiotic, see section \emph{Antibiotics} below.}
|
||||
|
||||
|
||||
@ -60,7 +60,7 @@ It has now created a file \code{"~/mo_source.rds"} with the contents of our Exce
|
||||
And now we can use it in our functions:
|
||||
|
||||
\if{html}{\out{<div class="sourceCode">}}\preformatted{as.mo("lab_mo_ecoli")
|
||||
#> Class <mo>
|
||||
#> Class 'mo'
|
||||
#> [1] B_ESCHR_COLI
|
||||
|
||||
mo_genus("lab_mo_kpneumoniae")
|
||||
@ -70,7 +70,7 @@ mo_genus("lab_mo_kpneumoniae")
|
||||
as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
||||
#> NOTE: Translation to one microorganism was guessed with uncertainty.
|
||||
#> Use mo_uncertainties() to review it.
|
||||
#> Class <mo>
|
||||
#> Class 'mo'
|
||||
#> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
||||
}\if{html}{\out{</div>}}
|
||||
|
||||
@ -91,7 +91,7 @@ If we edit the Excel file by, let's say, adding row 4 like this:
|
||||
#> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||
#> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#> "Organisation XYZ" and "mo"
|
||||
#> Class <mo>
|
||||
#> Class 'mo'
|
||||
#> [1] B_ESCHR_COLI
|
||||
|
||||
mo_genus("lab_Staph_aureus")
|
||||
|
||||
@ -25,7 +25,7 @@ random_rsi(size = NULL, prob_RSI = c(0.33, 0.33, 0.33), ...)
|
||||
\item{prob_RSI}{a vector of length 3: the probabilities for "R" (1st value), "S" (2nd value) and "I" (3rd value)}
|
||||
}
|
||||
\value{
|
||||
class \verb{<mic>} for \code{\link[=random_mic]{random_mic()}} (see \code{\link[=as.mic]{as.mic()}}) and class \verb{<disk>} for \code{\link[=random_disk]{random_disk()}} (see \code{\link[=as.disk]{as.disk()}})
|
||||
class \code{mic} for \code{\link[=random_mic]{random_mic()}} (see \code{\link[=as.mic]{as.mic()}}) and class \code{disk} for \code{\link[=random_disk]{random_disk()}} (see \code{\link[=as.disk]{as.disk()}})
|
||||
}
|
||||
\description{
|
||||
These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial agent, the generated results will reflect reality as much as possible.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user