1
0
mirror of https://github.com/msberends/AMR.git synced 2025-09-16 23:49:40 +02:00
This commit is contained in:
2023-06-10 10:18:19 +02:00
parent 89c447b290
commit 55b98ede4c
8 changed files with 29 additions and 9 deletions

View File

@@ -37,6 +37,7 @@
#' * `AMR_guideline` \cr Used for setting the default guideline for interpreting MIC values and disk diffusion diameters with [as.sir()]. Can be only the guideline name (e.g., `"CLSI"`) or the name with a year (e.g. `"CLSI 2019"`). The default to the latest implemented EUCAST guideline, currently \code{"`r clinical_breakpoints$guideline[1]`"}. Supported guideline are currently EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
#' * `AMR_ignore_pattern` \cr A [regular expression][base::regex] to ignore (i.e., make `NA`) any match given in [as.mo()] and all [`mo_*`][mo_property()] functions.
#' * `AMR_include_PKPD` \cr A [logical] to use in [as.sir()], to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`.
#' * `AMR_ecoff` \cr A [logical] use in [as.sir()], to indicate that ECOFF (Epidemiological Cut-Off) values must be used - the default is `FALSE`.
#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`.
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`.
#' * `AMR_cleaning_regex` \cr A [regular expression][base::regex] (case-insensitive) to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to clean the user input. The default is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar".

View File

@@ -257,7 +257,7 @@
#' - `disk_dose`\cr Dose of the used disk diffusion method
#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
#' - `ecoff`\cr Epidemiological cut-off (ECOFF) value, used in antimicrobial susceptibility testing to differentiate between wild-type and non-wild-type strains of bacteria or fungi (use [as.sir(..., ecoff = TRUE)] to interpret raw data using ECOFF values)
#' - `ecoff`\cr Epidemiological cut-off (ECOFF) value, used in antimicrobial susceptibility testing to differentiate between wild-type and non-wild-type strains of bacteria or fungi (use [`as.sir(..., ecoff = TRUE)`][as.sir()] to interpret raw data using ECOFF values)
#' - `uti`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
#' @details
#' Clinical breakpoints are validated through [WHONET](https://whonet.org), a free desktop Windows application developed and supported by the WHO Collaborating Centre for Surveillance of Antimicrobial Resistance. More can be read on [their website](https://whonet.org).

View File

@@ -136,11 +136,11 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
# get highest/lowest +/- random 1 to 3 higher factors of two
max_range <- mic_range[min(
length(mic_range),
which(mic_range == max(df$breakpoint_R)) + sample(c(1:3), 1)
which(mic_range == max(df$breakpoint_R, na.rm = TRUE)) + sample(c(1:3), 1)
)]
min_range <- mic_range[max(
1,
which(mic_range == min(df$breakpoint_S)) - sample(c(1:3), 1)
which(mic_range == min(df$breakpoint_S, na.rm = TRUE)) - sample(c(1:3), 1)
)]
mic_range_new <- mic_range[mic_range <= max_range & mic_range >= min_range]
@@ -158,8 +158,8 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
return(out)
} else if (type == "DISK") {
set_range <- seq(
from = as.integer(min(df$breakpoint_R) / 1.25),
to = as.integer(max(df$breakpoint_S) * 1.25),
from = as.integer(min(df$breakpoint_R, na.rm = TRUE) / 1.25),
to = as.integer(max(df$breakpoint_S, na.rm = TRUE) * 1.25),
by = 1
)
out <- sample(set_range, size = size, replace = TRUE)

15
R/sir.R
View File

@@ -43,6 +43,7 @@
#' @param add_intrinsic_resistance *(only useful when using a EUCAST guideline)* a [logical] to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in *Klebsiella* species. Determination is based on the [intrinsic_resistant] data set, that itself is based on `r format_eucast_version_nr(3.3)`.
#' @param include_screening a [logical] to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`. Can also be set with the [package option][AMR-options] [`AMR_include_screening`][AMR-options].
#' @param include_PKPD a [logical] to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`. Can also be set with the [package option][AMR-options] [`AMR_include_PKPD`][AMR-options].
#' @param ecoff a [logical] to indicate that ECOFF (Epidemiological Cut-Off) values must be used - the default is `FALSE`. Can also be set with the [package option][AMR-options] [`AMR_ecoff`][AMR-options].
#' @param reference_data a [data.frame] to be used for interpretation, which defaults to the [clinical_breakpoints] data set. Changing this argument allows for using own interpretation guidelines. This argument must contain a data set that is equal in structure to the [clinical_breakpoints] data set (same column names and column types). Please note that the `guideline` argument will be ignored when `reference_data` is manually set.
#' @param threshold maximum fraction of invalid antimicrobial interpretations of `x`, see *Examples*
#' @param ... for using on a [data.frame]: names of columns to apply [as.sir()] on (supports tidy selection such as `column1:column4`). Otherwise: arguments passed on to methods.
@@ -428,6 +429,7 @@ as.sir.mic <- function(x,
reference_data = AMR::clinical_breakpoints,
include_screening = getOption("AMR_include_screening", FALSE),
include_PKPD = getOption("AMR_include_PKPD", TRUE),
ecoff = getOption("AMR_ecoff", FALSE),
...) {
as_sir_method(
method_short = "mic",
@@ -442,6 +444,7 @@ as.sir.mic <- function(x,
reference_data = reference_data,
include_screening = include_screening,
include_PKPD = include_PKPD,
ecoff = ecoff,
...
)
}
@@ -457,6 +460,7 @@ as.sir.disk <- function(x,
reference_data = AMR::clinical_breakpoints,
include_screening = getOption("AMR_include_screening", FALSE),
include_PKPD = getOption("AMR_include_PKPD", TRUE),
ecoff = getOption("AMR_ecoff", FALSE),
...) {
as_sir_method(
method_short = "disk",
@@ -471,6 +475,7 @@ as.sir.disk <- function(x,
reference_data = reference_data,
include_screening = include_screening,
include_PKPD = include_PKPD,
ecoff = ecoff,
...
)
}
@@ -486,7 +491,8 @@ as.sir.data.frame <- function(x,
add_intrinsic_resistance = FALSE,
reference_data = AMR::clinical_breakpoints,
include_screening = getOption("AMR_include_screening", FALSE),
include_PKPD = getOption("AMR_include_PKPD", TRUE)) {
include_PKPD = getOption("AMR_include_PKPD", TRUE),
ecoff = getOption("AMR_ecoff", FALSE)) {
meet_criteria(x, allow_class = "data.frame") # will also check for dimensions > 0
meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
@@ -494,6 +500,9 @@ as.sir.data.frame <- function(x,
meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1)
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1)
meet_criteria(reference_data, allow_class = "data.frame")
meet_criteria(include_screening, allow_class = "logical", has_length = 1)
meet_criteria(include_PKPD, allow_class = "logical", has_length = 1)
meet_criteria(ecoff, allow_class = "logical", has_length = 1)
x.bak <- x
for (i in seq_len(ncol(x))) {
@@ -625,6 +634,7 @@ as.sir.data.frame <- function(x,
reference_data = reference_data,
include_screening = include_screening,
include_PKPD = include_PKPD,
ecoff = ecoff,
is_data.frame = TRUE
)
} else if (types[i] == "disk") {
@@ -642,6 +652,7 @@ as.sir.data.frame <- function(x,
reference_data = reference_data,
include_screening = include_screening,
include_PKPD = include_PKPD,
ecoff = ecoff,
is_data.frame = TRUE
)
} else if (types[i] == "sir") {
@@ -711,6 +722,7 @@ as_sir_method <- function(method_short,
reference_data,
include_screening,
include_PKPD,
ecoff,
...) {
meet_criteria(x, allow_NA = TRUE, .call_depth = -2)
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE, .call_depth = -2)
@@ -722,6 +734,7 @@ as_sir_method <- function(method_short,
meet_criteria(reference_data, allow_class = "data.frame", .call_depth = -2)
meet_criteria(include_screening, allow_class = "logical", has_length = 1, .call_depth = -2)
meet_criteria(include_PKPD, allow_class = "logical", has_length = 1, .call_depth = -2)
meet_criteria(ecoff, allow_class = "logical", has_length = 1, .call_depth = -2)
check_reference_data(reference_data, .call_depth = -2)
# for dplyr's across()