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

(v1.3.0.9004) data sets, as.disk() improvement

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-08-16 21:38:42 +02:00
parent e73f0e211c
commit dab017a50f
56 changed files with 1702 additions and 164 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
R/aa_helper_functions.R
View File

@ -575,3 +575,9 @@ isFALSE <- function(x) {
deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) {
paste(deparse(expr, width.cutoff, ...), collapse = collapse)
}
file.size <- function (...) {
base::file.info(...)$size
}
file.mtime <- function (...) {
base::file.info(...)$mtime
}

4
R/data.R
View File

@ -221,7 +221,7 @@ catalogue_of_life <- list(
#' Data set for R/SI interpretation
#'
#' Data set to interpret MIC and disk diffusion to R/SI values. Included guidelines are CLSI (2011-2019) and EUCAST (2011-2020). Use [as.rsi()] to transform MICs or disks measurements to R/SI values.
#' Data set to interpret MIC and disk diffusion to R/SI values. Included guidelines are CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`) and EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`). Use [as.rsi()] to transform MICs or disks measurements to R/SI values.
#' @format A [`data.frame`] with `r format(nrow(rsi_translation), big.mark = ",")` observations and `r ncol(rsi_translation)` variables:
#' - `guideline`\cr Name of the guideline
#' - `method`\cr Either "MIC" or "DISK"
@ -234,6 +234,8 @@ catalogue_of_life <- list(
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
#' - `uti`\cr A logical value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
#' @details The repository of this `AMR` package contains a file comprising this exact data set: <https://github.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt>. This file **allows for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the Excel and PDF files distributed by EUCAST and CLSI. The file is updated automatically.
#'
#'
#' @inheritSection AMR Read more on our website!
#' @seealso [intrinsic_resistant]
"rsi_translation"

23
R/disk.R
View File

@ -62,8 +62,27 @@ as.disk <- function(x, na.rm = FALSE) {
na_before <- length(x[is.na(x)])
# force it to be integer
x <- suppressWarnings(as.integer(x))
# heavily based on the function from our cleaner package:
clean_double2 <- function(x, remove = "[^0-9.,-]", fixed = FALSE) {
x <- gsub(",", ".", x)
# remove ending dot/comma
x <- gsub("[,.]$", "", x)
# only keep last dot/comma
reverse <- function(x) sapply(lapply(strsplit(x, NULL), rev), paste, collapse = "")
x <- sub("{{dot}}", ".",
gsub(".", "",
reverse(sub(".", "}}tod{{",
reverse(x),
fixed = TRUE)),
fixed = TRUE),
fixed = TRUE)
x_clean <- gsub(remove, "", x, ignore.case = TRUE, fixed = fixed)
# remove everything that is not a number or dot
as.numeric(gsub("[^0-9.]+", "", x_clean))
}
# round up and make it an integer
x <- as.integer(ceiling(clean_double2(x)))
# disks can never be less than 6 mm (size of smallest disk) or more than 50 mm
x[x < 6 | x > 50] <- NA_integer_

41
R/rsi.R
View File

@ -31,6 +31,7 @@
#' @inheritParams first_isolate
#' @param guideline defaults to the latest included EUCAST guideline, see Details for all options
#' @param conserve_capped_values a logical to indicate that MIC values starting with `">"` (but not `">="`) must always return "R" , and that MIC values starting with `"<"` (but not `"<="`) must always return "S"
#' @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 'EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes', version `r EUCAST_VERSION_EXPERT_RULES`.
#' @param threshold maximum fraction of invalid antimicrobial interpretations of `x`, please see *Examples*
#' @param ... parameters passed on to methods
#' @details
@ -108,6 +109,9 @@
#'
#' # the dplyr way
#' library(dplyr)
#' df %>% mutate_if(is.mic, as.rsi)
#' df %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.rsi)
#' df %>% mutate(across(where(is.mic), as.rsi))
#' df %>% mutate_at(vars(AMP:TOB), as.rsi)
#' df %>% mutate(across(AMP:TOB), as.rsi)
#'
@ -282,6 +286,7 @@ as.rsi.mic <- function(x,
guideline = "EUCAST",
uti = FALSE,
conserve_capped_values = FALSE,
add_intrinsic_resistance = FALSE,
...) {
# for dplyr's across()
@ -339,7 +344,8 @@ as.rsi.mic <- function(x,
ab = ab_coerced,
guideline = guideline_coerced,
uti = uti,
conserve_capped_values = conserve_capped_values) # exec_as.rsi will return message(font_blue(" OK."))
conserve_capped_values = conserve_capped_values,
add_intrinsic_resistance = add_intrinsic_resistance) # exec_as.rsi will return message(font_blue(" OK."))
result
}
@ -350,6 +356,7 @@ as.rsi.disk <- function(x,
ab = deparse(substitute(x)),
guideline = "EUCAST",
uti = FALSE,
add_intrinsic_resistance = FALSE,
...) {
# for dplyr's across()
@ -405,7 +412,9 @@ as.rsi.disk <- function(x,
mo = mo_coerced,
ab = ab_coerced,
guideline = guideline_coerced,
uti = uti) # exec_as.rsi will return message(font_blue(" OK."))
uti = uti,
conserve_capped_values = FALSE,
add_intrinsic_resistance = add_intrinsic_resistance) # exec_as.rsi will return message(font_blue(" OK."))
result
}
@ -416,6 +425,7 @@ as.rsi.data.frame <- function(x,
guideline = "EUCAST",
uti = NULL,
conserve_capped_values = FALSE,
add_intrinsic_resistance = FALSE,
...) {
# try to find columns based on type
# -- mo
@ -534,7 +544,15 @@ get_guideline <- function(guideline) {
}
exec_as.rsi <- function(method, x, mo, ab, guideline, uti, conserve_capped_values) {
exec_as.rsi <- function(method,
x,
mo,
ab,
guideline,
uti,
conserve_capped_values,
add_intrinsic_resistance) {
x_bak <- data.frame(x_mo = paste0(x, mo))
df <- unique(data.frame(x, mo), stringsAsFactors = FALSE)
x <- df$x
@ -580,10 +598,23 @@ exec_as.rsi <- function(method, x, mo, ab, guideline, uti, conserve_capped_value
warning("Interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " for some microorganisms is only available for (uncomplicated) urinary tract infections (UTI).\n Use parameter 'uti' to set which isolates are from urine. See ?as.rsi.", call. = FALSE)
warned <- TRUE
}
for (i in seq_len(length(x))) {
if (isTRUE(add_intrinsic_resistance)) {
if (!guideline_coerced %like% "EUCAST") {
warning("Using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.", call. = FALSE)
} else {
get_record <- subset(intrinsic_resistant,
microorganism == mo_name(mo[i], language = NULL) & antibiotic == ab_name(ab, language = NULL))
if (nrow(get_record) > 0) {
new_rsi[i] <- "R"
next
}
}
}
get_record <- trans %>%
# no sebsetting to UTI for now
# no subsetting to UTI for now
subset(lookup %in% c(lookup_mo[i],
lookup_genus[i],
lookup_family[i],