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

(v1.3.0.9003) as.rsi() speed improvement

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-08-15 12:54:47 +02:00
parent 08d62bb5d5
commit e73f0e211c
25 changed files with 96 additions and 82 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
R/aa_helper_functions.R
View File

@ -62,14 +62,12 @@ left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
if (length(by) == 1) {
by <- rep(by, 2)
}
requires_suffix <- any(colnames(x) %in% colnames(y))
if (requires_suffix == TRUE) {
int_x <- colnames(x) %in% colnames(y) & colnames(x) != by[1]
int_y <- colnames(y) %in% colnames(x) & colnames(y) != by[2]
colnames(x)[int_x] <- paste0(colnames(x)[int_x], suffix[1L])
colnames(y)[int_y] <- paste0(colnames(y)[int_y], suffix[2L])
}
int_x <- colnames(x) %in% colnames(y) & colnames(x) != by[1]
int_y <- colnames(y) %in% colnames(x) & colnames(y) != by[2]
colnames(x)[int_x] <- paste0(colnames(x)[int_x], suffix[1L])
colnames(y)[int_y] <- paste0(colnames(y)[int_y], suffix[2L])
merged <- cbind(x,
y[match(x[, by[1], drop = TRUE],
y[, by[2], drop = TRUE]),

1
R/data.R
View File

@ -255,5 +255,4 @@ catalogue_of_life <- list(
#' pull(microorganism)
#' # [1] "Enterococcus casseliflavus" "Enterococcus gallinarum"
#' }
#' @seealso [intrinsic_resistant]
"intrinsic_resistant"

21
R/rsi.R
View File

@ -311,7 +311,7 @@ as.rsi.mic <- function(x,
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
"To transform certain columns with e.g. mutate_at(), use\n",
"`data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n\n",
"To tranform all MIC variables in a data set, use `as.rsi(data)` or `data %>% as.rsi()`.", call = FALSE)
"To tranform all MIC values in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.mic, as.rsi).", call = FALSE)
}
ab_coerced <- suppressWarnings(as.ab(ab))
@ -379,7 +379,7 @@ as.rsi.disk <- function(x,
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
"To transform certain columns with e.g. mutate_at(), use\n",
"`data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n\n",
"To tranform all disk diffusion zones in a data set, use `as.rsi(data)` or `data %>% as.rsi()`.", call = FALSE)
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
}
ab_coerced <- suppressWarnings(as.ab(ab))
@ -535,6 +535,11 @@ get_guideline <- function(guideline) {
}
exec_as.rsi <- function(method, x, mo, ab, guideline, uti, conserve_capped_values) {
x_bak <- data.frame(x_mo = paste0(x, mo))
df <- unique(data.frame(x, mo), stringsAsFactors = FALSE)
x <- df$x
mo <- df$mo
if (method == "mic") {
x <- as.mic(x) # when as.rsi.mic is called directly
} else if (method == "disk") {
@ -575,10 +580,10 @@ 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))) {
get_record <- trans %>%
# no UTI for now
# no sebsetting to UTI for now
subset(lookup %in% c(lookup_mo[i],
lookup_genus[i],
lookup_family[i],
@ -591,7 +596,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline, uti, conserve_capped_value
get_record <- get_record %>%
# be as specific as possible (i.e. prefer species over genus):
# desc(uti) = TRUE on top and FALSE on bottom
arrange(desc(uti), desc(nchar(mo))) # 'uti' is a column in rsi_translation
arrange(desc(uti), desc(nchar(mo))) # 'uti' is a column in data set 'rsi_translation'
} else {
get_record <- get_record %>%
filter(uti == FALSE) %>% # 'uti' is a column in rsi_translation
@ -620,9 +625,15 @@ exec_as.rsi <- function(method, x, mo, ab, guideline, uti, conserve_capped_value
}
}
}
new_rsi <- x_bak %>%
left_join(data.frame(x_mo = paste0(df$x, df$mo), new_rsi), by = "x_mo") %>%
pull(new_rsi)
if (warned == FALSE) {
message(font_green("OK."))
}
structure(.Data = factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
class = c("rsi", "ordered", "factor"))
}