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.2.0.9024) AMR calculation speed improvement

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-07-03 10:51:55 +02:00
parent 152ac5bcad
commit 46cf423eab
12 changed files with 38 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
R/rsi_calc.R
View File

@ -101,7 +101,7 @@ rsi_calc <- function(...,
if (is.data.frame(x)) {
rsi_integrity_check <- character(0)
for (i in seq_len(ncol(x))) {
# check integrity of columns: force rsi class
# check integrity of columns: force <rsi> class
if (!is.rsi(x[, i, drop = TRUE])) {
rsi_integrity_check <- c(rsi_integrity_check, as.character(x[, i, drop = TRUE]))
x[, i] <- suppressWarnings(as.rsi(x[, i, drop = TRUE])) # warning will be given later
@ -113,22 +113,16 @@ rsi_calc <- function(...,
rsi_integrity_check <- as.rsi(rsi_integrity_check)
}
x_transposed <- as.list(as.data.frame(t(x)))
if (only_all_tested == TRUE) {
# THE NUMBER OF ISOLATES WHERE *ALL* ABx ARE S/I/R
x <- apply(X = as.data.frame(lapply(x, as.integer), stringsAsFactors = FALSE),
MARGIN = 1,
FUN = base::min)
numerator <- sum(as.integer(x) %in% as.integer(ab_result), na.rm = TRUE)
denominator <- length(x) - sum(is.na(x))
# no NAs in any column
numerator <- sum(sapply(x_transposed, function(y) !any(is.na(y)) & any(y %in% ab_result, na.rm = TRUE)))
denominator <- sum(sapply(x_transposed, function(y) !(any(is.na(y)))))
} else {
# THE NUMBER OF ISOLATES WHERE *ANY* ABx IS S/I/R
# may contain NAs in any column
other_values <- base::setdiff(c(NA, levels(ab_result)), ab_result)
other_values_filter <- base::apply(x, 1, function(y) {
base::all(y %in% other_values) & base::any(is.na(y))
})
numerator <- sum(as.logical(by(x, seq_len(nrow(x)), function(row) any(unlist(row) %in% ab_result, na.rm = TRUE))))
denominator <- nrow(x[!other_values_filter, , drop = FALSE])
numerator <- sum(sapply(x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE)))
denominator <- sum(sapply(x_transposed, function(y) !(all(y %in% other_values) & any(is.na(y)))))
}
} else {
# x is not a data.frame
@ -153,7 +147,7 @@ rsi_calc <- function(...,
if (data_vars != "") {
data_vars <- paste(" for", data_vars)
}
warning("Introducing NA: only ", denominator, " results available", data_vars, " (`minimum` was set to ", minimum, ").", call. = FALSE)
warning("Introducing NA: only ", denominator, " results available", data_vars, " (`minimum` = ", minimum, ").", call. = FALSE)
fraction <- NA
} else {
fraction <- numerator / denominator