P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 16:42:10 +02:00
Code Releases Activity

fixes

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2023-01-21 11:07:55 +01:00
parent bee337dfe0
commit ee38689172
29 changed files with 18362 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/aa_helper_functions.R
View File

@ -667,7 +667,7 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca
}
if (identical(v, c("I", "R", "S"))) {
# class 'sir' should be sorted like this
v <- c("R", "S", "I")
v <- c("S", "I", "R")
}
# all commas except for last item, so will become '"val1", "val2", "val3" or "val4"'
paste0(

10
R/ab_selectors.R
View File

@ -639,10 +639,10 @@ c.ab_selector <- function(...) {
all_any_ab_selector <- function(type, ..., na.rm = TRUE) {
cols_ab <- c(...)
result <- cols_ab[toupper(cols_ab) %in% c("R", "S", "I")]
result <- cols_ab[toupper(cols_ab) %in% c("S", "I", "R")]
if (length(result) == 0) {
message_("Filtering ", type, " of columns ", vector_and(font_bold(cols_ab, collapse = NULL), quotes = "'"), ' to contain value "R", "S" or "I"')
result <- c("R", "S", "I")
message_("Filtering ", type, " of columns ", vector_and(font_bold(cols_ab, collapse = NULL), quotes = "'"), ' to contain value "S", "I" or "R"')
result <- c("S", "I", "R")
}
cols_ab <- cols_ab[!cols_ab %in% result]
df <- get_current_data(arg_name = NA, call = -3)
@ -751,8 +751,8 @@ any.ab_selector_any_all <- function(..., na.rm = FALSE) {
}
}
# this is `!=`, so turn around the values
rsi <- c("R", "S", "I")
e2 <- rsi[rsi != e2]
sir <- c("S", "I", "R")
e2 <- sir[sir != e2]
structure(all_any_ab_selector(type = type, e1, e2),
class = c("ab_selector_any_all", "logical")
)

4
R/custom_eucast_rules.R
View File

@ -181,8 +181,8 @@ custom_eucast_rules <- function(...) {
result_value <- as.character(result)[[3]]
result_value[result_value == "NA"] <- NA
stop_ifnot(
result_value %in% c("R", "S", "I", NA),
"the resulting value of rule ", i, " must be either \"R\", \"S\", \"I\" or NA"
result_value %in% c("S", "I", "R", NA),
"the resulting value of rule ", i, " must be either \"S\", \"I\", \"R\" or NA"
)
result_value <- as.sir(result_value)

2
R/first_isolate.R
View File

@ -237,7 +237,7 @@ first_isolate <- function(x = NULL,
FUN.VALUE = logical(1),
X = x,
# check only first 10,000 rows
FUN = function(x) any(as.character(x[1:10000]) %in% c("R", "S", "I"), na.rm = TRUE),
FUN = function(x) any(as.character(x[1:10000]) %in% c("S", "I", "R"), na.rm = TRUE),
USE.NAMES = FALSE
))
if (method == "phenotype-based" && !any_col_contains_sir) {

6
R/key_antimicrobials.R
View File

@ -282,7 +282,7 @@ generate_antimcrobials_string <- function(df) {
as.list(df),
function(x) {
x <- toupper(as.character(x))
x[!x %in% c("R", "S", "I")] <- "."
x[!x %in% c("S", "I", "R")] <- "."
paste(x)
}
)
@ -308,7 +308,7 @@ antimicrobials_equal <- function(y,
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
key2rsi <- function(val) {
key2sir <- function(val) {
val <- strsplit(val, "", fixed = TRUE)[[1L]]
val.int <- rep(NA_real_, length(val))
val.int[val == "S"] <- 1
@ -318,7 +318,7 @@ antimicrobials_equal <- function(y,
}
# only run on uniques
uniq <- unique(c(y, z))
uniq_list <- lapply(uniq, key2rsi)
uniq_list <- lapply(uniq, key2sir)
names(uniq_list) <- uniq
y <- uniq_list[match(y, names(uniq_list))]

8
R/mean_amr_distance.R
View File

@ -30,7 +30,7 @@
#' Calculate the Mean AMR Distance
#'
#' Calculates a normalised mean for antimicrobial resistance between multiple observations, to help to identify similar isolates without comparing antibiograms by hand.
#' @param x a vector of class [rsi][as.sir()], [mic][as.mic()] or [disk][as.disk()], or a [data.frame] containing columns of any of these classes
#' @param x a vector of class [sir][as.sir()], [mic][as.mic()] or [disk][as.disk()], or a [data.frame] containing columns of any of these classes
#' @param ... variables to select (supports [tidyselect language][tidyselect::language] such as `column1:column4` and `where(is.mic)`, and can thus also be [antibiotic selectors][ab_selector()]
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the input only consists of S+I vs. R (susceptible vs. resistant), defaults to `TRUE`
#' @details The mean AMR distance is effectively [the Z-score](https://en.wikipedia.org/wiki/Standard_score); a normalised numeric value to compare AMR test results which can help to identify similar isolates, without comparing antibiograms by hand.
@ -46,9 +46,9 @@
#' Isolates with distances less than 0.01 difference from each other should be considered similar. Differences lower than 0.025 should be considered suspicious.
#' @export
#' @examples
#' rsi <- random_sir(10)
#' rsi
#' mean_amr_distance(rsi)
#' sir <- random_sir(10)
#' sir
#' mean_amr_distance(sir)
#'
#' mic <- random_mic(10)
#' mic

6
R/proportion.R
View File

@ -40,7 +40,7 @@
#' @param translate_ab a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]
#' @inheritParams ab_property
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant), defaults to `TRUE`
#' @param ab_result antibiotic results to test against, must be one of more values of "R", "S", "I"
#' @param ab_result antibiotic results to test against, must be one or more values of "S", "I", or "R"
#' @param confidence_level the confidence level for the returned confidence interval. For the calculation, the number of S or SI isolates, and R isolates are compared with the total number of available isolates with R, S, or I by using [binom.test()], i.e., the Clopper-Pearson method.
#' @param side the side of the confidence interval to return. Defaults to `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
#' @inheritSection as.sir Interpretation of SIR
@ -200,7 +200,7 @@
#' combination_n = count_all(CIP, GEN)
#' )
#'
#' # Get proportions S/I/R immediately of all rsi columns
#' # Get proportions S/I/R immediately of all sir columns
#' example_isolates %>%
#' select(AMX, CIP) %>%
#' proportion_df(translate = FALSE)
@ -256,7 +256,7 @@ sir_confidence_interval <- function(...,
only_all_tested = FALSE,
confidence_level = 0.95,
side = "both") {
meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1, 2, 3), is_in = c("R", "S", "I"))
meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1, 2, 3), is_in = c("S", "I", "R"))
meet_criteria(confidence_level, allow_class = "numeric", is_positive = TRUE, has_length = 1)
meet_criteria(side, allow_class = "character", has_length = 1, is_in = c("both", "b", "left", "l", "lower", "lowest", "less", "min", "right", "r", "higher", "highest", "greater", "g", "max"))
x <- tryCatch(

12
R/sir.R
View File

@ -27,7 +27,7 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Interpret MIC and Disk Values, or Clean Raw SIR Data
#' Translate MIC and Disk Diffusion to SIR, or Clean Existing SIR Data
#'
#' Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing SIR values. This transforms the input to a new class [`sir`], which is an ordered [factor] with levels `S < I < R`.
#' @rdname as.sir
@ -258,9 +258,9 @@ is_sir_eligible <- function(x, threshold = 0.05) {
%in% class(x))) {
# no transformation needed
return(FALSE)
} else if (all(x %in% c("R", "S", "I", NA)) & !all(is.na(x))) {
} else if (all(x %in% c("S", "I", "R", NA)) & !all(is.na(x))) {
return(TRUE)
} else if (!any(c("R", "S", "I") %in% x, na.rm = TRUE) & !all(is.na(x))) {
} else if (!any(c("S", "I", "R") %in% x, na.rm = TRUE) & !all(is.na(x))) {
return(FALSE)
} else {
x <- x[!is.na(x) & !is.null(x) & !x %in% c("", "-", "NULL")]
@ -301,7 +301,7 @@ as.sir.default <- function(x, ...) {
if (inherits(x.bak, c("integer", "numeric", "double")) && all(x %in% c(1:3, NA))) {
# support haven package for importing e.g., from SPSS - it adds the 'labels' attribute
lbls <- attributes(x.bak)$labels
if (!is.null(lbls) && all(c("R", "S", "I") %in% names(lbls)) && all(c(1:3) %in% lbls)) {
if (!is.null(lbls) && all(c("S", "I", "R") %in% names(lbls)) && all(c(1:3) %in% lbls)) {
x[x.bak == 1] <- names(lbls[lbls == 1])
x[x.bak == 2] <- names(lbls[lbls == 2])
x[x.bak == 3] <- names(lbls[lbls == 3])
@ -314,7 +314,7 @@ as.sir.default <- function(x, ...) {
x[x.bak == "1"] <- "S"
x[x.bak == "2"] <- "I"
x[x.bak == "3"] <- "R"
} else if (!all(is.na(x)) && !identical(levels(x), c("R", "S", "I")) && !all(x %in% c("R", "S", "I", NA))) {
} else if (!all(is.na(x)) && !identical(levels(x), c("S", "I", "R")) && !all(x %in% c("S", "I", "R", NA))) {
if (all(x %unlike% "(R|S|I)", na.rm = TRUE)) {
# check if they are actually MICs or disks
if (all_valid_mics(x)) {
@ -625,7 +625,7 @@ as.sir.data.frame <- function(x,
show_message <- FALSE
ab <- ab_cols[i]
ab_coerced <- suppressWarnings(as.ab(ab))
if (!all(x[, ab_cols[i], drop = TRUE] %in% c("R", "S", "I", NA), na.rm = TRUE)) {
if (!all(x[, ab_cols[i], drop = TRUE] %in% c("S", "I", "R", NA), na.rm = TRUE)) {
show_message <- TRUE
# only print message if values are not already clean
message_("=> Cleaning values in column '", font_bold(ab), "' (",

2
R/vctrs.R
View File

@ -141,7 +141,7 @@ vec_math.mic <- function(.fn, x, ...) {
.fn(as.double(x), ...)
}
# S3: rsi
# S3: sir
vec_ptype2.character.sir <- function(x, y, ...) {
x
}

2
R/zzz.R
View File

@ -166,7 +166,7 @@ if (utf8_supported && !is_latex) {
s3_register("vctrs::vec_cast", "mic.character")
s3_register("vctrs::vec_cast", "mic.double")
s3_register("vctrs::vec_math", "mic")
# S3: rsi
# S3: sir
s3_register("vctrs::vec_ptype2", "character.sir")
s3_register("vctrs::vec_ptype2", "sir.character")
s3_register("vctrs::vec_cast", "character.sir")