1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 21:42:01 +02:00

(v1.7.1.9064) eucast 3.3 for mdro(), major change to repeated calling

This commit is contained in:
2021-12-11 13:41:31 +01:00
parent e18c49ed93
commit 77ba4318ea
64 changed files with 51141 additions and 9840 deletions

View File

@ -75,7 +75,8 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_r
meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = FALSE)
}
all_found <- get_column_abx(x, info = verbose, only_rsi_columns = only_rsi_columns, verbose = verbose)
all_found <- get_column_abx(x, info = verbose, only_rsi_columns = only_rsi_columns,
verbose = verbose, fn = "guess_ab_col")
search_string.ab <- suppressWarnings(as.ab(search_string))
ab_result <- unname(all_found[names(all_found) == search_string.ab])
@ -104,10 +105,12 @@ get_column_abx <- function(x,
info = TRUE,
only_rsi_columns = FALSE,
sort = TRUE,
reuse_previous_result = TRUE) {
reuse_previous_result = TRUE,
fn = NULL) {
# check if retrieved before, then get it from package environment
if (isTRUE(reuse_previous_result) && identical(unique_call_id(entire_session = FALSE), pkg_env$get_column_abx.call)) {
if (isTRUE(reuse_previous_result) && identical(unique_call_id(entire_session = FALSE,
match_fn = fn),
pkg_env$get_column_abx.call)) {
# so within the same call, within the same environment, we got here again.
# but we could've come from another function within the same call, so now only check the columns that changed
@ -194,6 +197,8 @@ get_column_abx <- function(x,
# such as get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
all_okay <- TRUE
dots <- list(...)
# remove data.frames, since this is also used running `eucast_rules(eucast_rules_df = df)`
dots <- dots[!vapply(FUN.VALUE = logical(1), dots, is.data.frame)]
if (length(dots) > 0) {
newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
if (any(is.na(newnames))) {
@ -228,7 +233,7 @@ get_column_abx <- function(x,
if (info == TRUE & all_okay == TRUE) {
message_("No columns found.")
}
pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE)
pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE, match_fn = fn)
pkg_env$get_column_abx.checked_cols <- colnames(x.bak)
pkg_env$get_column_abx.out <- out
return(out)
@ -240,32 +245,40 @@ get_column_abx <- function(x,
}
# only keep the first hits, no duplicates
duplicates <- c(out[duplicated(names(out))], out[duplicated(unname(out))])
if (length(duplicates) > 0) {
all_okay <- FALSE
}
if (info == TRUE) {
if (all_okay == TRUE) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
} else {
message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
}
for (i in seq_len(length(out))) {
if (verbose == TRUE & !names(out[i]) %in% names(duplicates)) {
message_("Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
" (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ").")
}
if (names(out[i]) %in% names(duplicates)) {
already_set_as <- out[unname(out) == unname(out[i])][1L]
warning_(paste0("Column '", font_bold(out[i]), "' will not be used for ",
names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
", as it is already set for ",
names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"),
add_fn = font_red,
call = FALSE,
immediate = verbose)
}
}
}
out <- out[!duplicated(names(out))]
out <- out[!duplicated(unname(out))]
if (sort == TRUE) {
out <- out[order(names(out), out)]
}
# succeeded with auto-guessing
if (info == TRUE & all_okay == TRUE) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
for (i in seq_len(length(out))) {
if (info == TRUE & verbose == TRUE & !names(out[i]) %in% names(duplicates)) {
message_("Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
" (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ").")
}
if (info == TRUE & names(out[i]) %in% names(duplicates)) {
warning_(paste0("Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
" (", ab_name(names(out)[i], tolower = TRUE, language = NULL),
"), although it was matched for multiple antibiotics or columns."),
add_fn = font_red,
call = FALSE,
immediate = verbose)
}
}
if (!is.null(hard_dependencies)) {
hard_dependencies <- unique(hard_dependencies)
if (!all(hard_dependencies %in% names(out))) {
@ -288,7 +301,7 @@ get_column_abx <- function(x,
}
}
pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE)
pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE, match_fn = fn)
pkg_env$get_column_abx.checked_cols <- colnames(x.bak)
pkg_env$get_column_abx.out <- out
out