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

(v1.2.0.9033) speed improvement mdro(), filter_ab_class()

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-07-12 11:43:31 +02:00
parent 1d66b5c43c
commit c0cf7ab02b
17 changed files with 69 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
R/filter_ab_class.R
View File

@ -27,7 +27,7 @@
#' @param ab_class an antimicrobial class, like `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
#' @param result an antibiotic result: S, I or R (or a combination of more of them)
#' @param scope the scope to check which variables to check, can be `"any"` (default) or `"all"`
#' @param ... parameters passed on to `filter_at` from the `dplyr` package
#' @param ... previously used when this package still depended on the `dplyr` package, now ignored
#' @details All columns of `x` will be searched for known antibiotic names, abbreviations, brand names and codes (ATC, EARS-Net, WHO, etc.). This means that a filter function like e.g. [filter_aminoglycosides()] will include column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
#' @rdname filter_ab_class
#' @seealso [antibiotic_class_selectors()] for the `select()` equivalent.
@ -85,13 +85,13 @@ filter_ab_class <- function(x,
# make result = "SI" works too:
result <- unlist(strsplit(result, ""))
stop_ifnot(all(result %in% c("S", "I", "R")), "`result` must be one or more of: S, I, R")
stop_ifnot(all(scope %in% c("any", "all")), "`scope` must be one of: any, all")
stop_ifnot(all(result %in% c("S", "I", "R")), "`result` must be one or more of: 'S', 'I', 'R'")
stop_ifnot(all(scope %in% c("any", "all")), "`scope` must be one of: 'any', 'all'")
# get all columns in data with names that resemble antibiotics
ab_in_data <- suppressMessages(get_column_abx(x))
if (length(ab_in_data) == 0) {
message(font_blue("NOTE: no antimicrobial agents found, data left unchanged."))
message(font_blue("NOTE: no columns with class <rsi> found (see ?as.rsi), data left unchanged."))
return(x.bak)
}
# get reference data
@ -146,8 +146,8 @@ filter_ab_class <- function(x,
"` (", ab_name(names(agents), tolower = TRUE, language = NULL), ")"),
collapse = scope_txt),
operator, toString(result))))
filtered <- as.logical(by(x, seq_len(nrow(x)),
function(row) scope_fn(unlist(row[, agents]) %in% result, na.rm = TRUE)))
x_transposed <- as.list(as.data.frame(t(x[, agents, drop = FALSE])))
filtered <- sapply(x_transposed, function(y) scope_fn(y %in% result, na.rm = TRUE))
x <- x[which(filtered), , drop = FALSE]
class(x) <- x_class
x

10
R/mdro.R
View File

@ -468,9 +468,8 @@ mdro <- function(x,
} else if (any_all == "all") {
search_function <- all
}
row_filter <- as.logical(by(x,
seq_len(nrow(x)),
function(row) search_function(unlist(row[, cols]) %in% search_result, na.rm = TRUE)))
x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE])))
row_filter <- sapply(x_transposed, function(y) search_function(y %in% search_result, na.rm = TRUE))
row_filter <- x[row_filter, "row_number", drop = TRUE]
rows <- rows[rows %in% row_filter]
x[rows, "MDRO"] <<- to
@ -507,9 +506,8 @@ mdro <- function(x,
na.rm = TRUE)
})
# for PDR; all agents are R (or I if combine_SI = FALSE)
row_filter <- as.logical(by(x[rows, ],
seq_len(nrow(x[rows, ])),
function(row) all(unlist(row[, lst_vector]) %in% search_result, na.rm = TRUE)))
x_transposed <- as.list(as.data.frame(t(x[rows, lst_vector, drop = FALSE])))
row_filter <- sapply(x_transposed, function(y) all(y %in% search_result, na.rm = TRUE))
x[row_filter, "classes_affected"] <<- 999
}