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

(v2.1.1.9278) support AMR selectors in custom MDRO guideline

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-05-16 11:20:19 +02:00
parent b8d7c8af7f
commit 139f79d372
15 changed files with 582 additions and 514 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
R/aa_helper_functions.R
View File

@ -1020,6 +1020,17 @@ get_current_data <- function(arg_name, call) {
}
}
# now check if it was run with eval(), which has arguments `expr`, `envir`, and `enclos`
from_eval_parse <- vapply(FUN.VALUE = logical(1), frms, function(e) all(c("expr", "envir", "enclos") %in% names(e)))
for (env in frms[which(from_eval_parse)]) {
if (valid_df(env$envir)) {
# the element `envir` could contain the data in case of
# e.g. `eval(parse(text = "any(cephalosporins_3rd() == 'R')"), envir = example_isolates)`
# this is also used by run_custom_mdro_guideline() to support antimicrobial selectors in the part before `~`
return(env$envir)
}
}
# no data.frame found, so an error must be returned:
if (is.na(arg_name)) {
if (isTRUE(is.numeric(call))) {
@ -1104,6 +1115,44 @@ get_group_names <- function(x) {
}
}
format_custom_query_rule <- function(query, colours = has_colour()) {
# this is used by custom EUCAST and custom MDRO rules
# font_black() is a bit expensive so do it once:
txt <- font_black("{text}")
query <- gsub(" & ", sub("{text}", font_bold(" and "), txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" | ", sub("{text}", " or ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" + ", sub("{text}", " plus ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" - ", sub("{text}", " minus ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" / ", sub("{text}", " divided by ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" * ", sub("{text}", " times ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" == ", sub("{text}", " is ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" > ", sub("{text}", " is higher than ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" < ", sub("{text}", " is lower than ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" >= ", sub("{text}", " is higher than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" <= ", sub("{text}", " is lower than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" ^ ", sub("{text}", " to the power of ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" %in% ", sub("{text}", " is one of ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub(" %like% ", sub("{text}", " resembles ", txt, fixed = TRUE), query, fixed = TRUE)
query <- gsub("any\\((.*)\\)$", paste0(font_black("any of "), "\\1"), query)
query <- gsub("all\\((.*)\\)$", paste0(font_black("all of "), "\\1"), query)
if (colours == TRUE) {
query <- gsub("[\"']R[\"']", font_rose_bg(" R "), query)
query <- gsub("[\"']SDD[\"']", font_orange_bg(" SDD "), query)
query <- gsub("[\"']S[\"']", font_green_bg(" S "), query)
query <- gsub("[\"']NI[\"']", font_grey_bg(font_black(" NI ")), query)
query <- gsub("[\"']I[\"']", font_orange_bg(" I "), query)
}
# replace the black colour 'stops' with blue colour 'starts'
query <- gsub("\033[39m", "\033[34m", as.character(query), fixed = TRUE)
# start with blue
query <- paste0("\033[34m", query)
if (colours == FALSE) {
query <- font_stripstyle(query)
}
query
}
unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
if (entire_session == TRUE) {
return(c(envir = "session", call = "session"))