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

Replace RSI with SIR

Browse Source
This commit is contained in:
Dr. Matthijs Berends
2023-01-21 23:47:20 +01:00
committed by GitHub
parent 24b12024ce
commit 98e62c9af2
127 changed files with 1746 additions and 1648 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
R/aa_helper_functions.R
View File

@ -225,6 +225,8 @@ search_type_in_df <- function(x, type, info = TRUE) {
# -- mo
if (type == "mo") {
add_MO_lookup_to_AMR_env()
if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) {
# take first 'mo' column
found <- colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)]
@ -515,7 +517,7 @@ stop_ <- function(..., call = TRUE) {
if (isTRUE(call)) {
call <- as.character(sys.call(-1)[1])
} else {
# so you can go back more than 1 call, as used in rsi_calc(), that now throws a reference to e.g. n_rsi()
# so you can go back more than 1 call, as used in sir_calc(), that now throws a reference to e.g. n_sir()
call <- as.character(sys.call(call)[1])
}
msg <- paste0("in ", call, "(): ", msg)
@ -626,7 +628,7 @@ create_eucast_ab_documentation <- function() {
# separate drugs, such as `AMX`
val <- as.ab(val)
} else {
val <- as.rsi(NA)
val <- as.sir(NA)
}
ab <- c(ab, val)
}
@ -666,8 +668,8 @@ 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
v <- c("R", "S", "I")
# class 'sir' should be sorted like this
v <- c("S", "I", "R")
}
# all commas except for last item, so will become '"val1", "val2", "val3" or "val4"'
paste0(
@ -710,7 +712,7 @@ format_class <- function(class, plural = FALSE) {
if ("custom_eucast_rules" %in% class) {
class <- "input created with `custom_eucast_rules()`"
}
if (any(c("mo", "ab", "rsi") %in% class)) {
if (any(c("mo", "ab", "sir") %in% class)) {
class <- paste0("of class <", class[1L], ">")
}
class[class == class.bak] <- paste0("of class <", class[class == class.bak], ">")
@ -1140,18 +1142,18 @@ font_grey_bg <- function(..., collapse = " ") {
}
}
font_red_bg <- function(..., collapse = " ") {
# this is #ed553b (picked to be colourblind-safe with other RSI colours)
# this is #ed553b (picked to be colourblind-safe with other SIR colours)
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;203m", after = "\033[49m", collapse = collapse)
}
font_orange_bg <- function(..., collapse = " ") {
# this is #f6d55c (picked to be colourblind-safe with other RSI colours)
# this is #f6d55c (picked to be colourblind-safe with other SIR colours)
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;222m", after = "\033[49m", collapse = collapse)
}
font_yellow_bg <- function(..., collapse = " ") {
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;228m", after = "\033[49m", collapse = collapse)
}
font_green_bg <- function(..., collapse = " ") {
# this is #3caea3 (picked to be colourblind-safe with other RSI colours)
# this is #3caea3 (picked to be colourblind-safe with other SIR colours)
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
}
font_purple_bg <- function(..., collapse = " ") {
@ -1379,6 +1381,38 @@ add_intrinsic_resistance_to_AMR_env <- function() {
}
}
add_MO_lookup_to_AMR_env <- function() {
# for all MO functions, saves a lot of time on package load and in package size
if (is.null(AMR_env$MO_lookup)) {
MO_lookup <- AMR::microorganisms
MO_lookup$kingdom_index <- NA_real_
MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1
MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 2
MO_lookup[which(MO_lookup$kingdom == "Protozoa"), "kingdom_index"] <- 3
MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 4
# all the rest
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
# the fullname lowercase, important for the internal algorithms in as.mo()
MO_lookup$fullname_lower <- tolower(trimws(paste(
MO_lookup$genus,
MO_lookup$species,
MO_lookup$subspecies
)))
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname, perl = TRUE)
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname", drop = TRUE])
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
# special for Salmonella - they have cities as subspecies but not the species (enterica) in the fullname:
MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")] <- gsub(" enterica ", " ", MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")], fixed = TRUE)
MO_lookup$full_first <- substr(MO_lookup$fullname_lower, 1, 1)
MO_lookup$species_first <- tolower(substr(MO_lookup$species, 1, 1)) # tolower for groups (Streptococcus, Salmonella)
MO_lookup$subspecies_first <- tolower(substr(MO_lookup$subspecies, 1, 1)) # tolower for Salmonella serovars
AMR_env$MO_lookup <- MO_lookup
}
}
trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u0085\u00A0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u200C\u200D\u2028\u2029\u202F\u205F\u2060\u3000\uFEFF]") {
# this is even faster than trimws() itself which sets " \t\n\r".
trimws(..., whitespace = whitespace)