P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 12:31:58 +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

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
}