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

interpretation fixes

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2023-07-11 09:50:45 +02:00
parent 5e1221bceb
commit 8df1cd8d97
10 changed files with 63 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
R/aa_helper_functions.R
View File

@ -501,8 +501,19 @@ word_wrap <- function(...,
}
# format backticks
if (pkg_is_available("cli") &&
tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) return(FALSE))) {
parts <- strsplit(msg, "`", fixed = TRUE)[[1]]
cmds <- parts %in% paste0(ls(envir = asNamespace("AMR")), "()")
# functions with a dot are not allowed: https://github.com/rstudio/rstudio/issues/11273#issuecomment-1156193252
parts[cmds & parts %like% "[.]"] <- font_url(url = paste0("ide:help:AMR::", gsub("()", "", parts[cmds & parts %like% "[.]"], fixed = TRUE)),
txt = parts[cmds & parts %like% "[.]"])
parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
txt = parts[cmds & parts %unlike% "[.]"])
msg <- paste0(parts, collapse = "`")
}
msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg)
# clean introduced whitespace between fullstops
msg <- gsub("[.] +[.]", "..", msg)
# remove extra space that was introduced (e.g. "Smith et al. , 2022")

7
R/ab.R
View File

@ -545,6 +545,13 @@ is.ab <- function(x) {
pillar_shaft.ab <- function(x, ...) {
out <- trimws(format(x))
out[is.na(x)] <- font_na(NA)
# add the names to the drugs as mouse-over!
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
out[!is.na(x)] <- font_url(url = ab_name(x[!is.na(x)], language = NULL),
txt = out[!is.na(x)])
}
create_pillar_column(out, align = "left", min_width = 4)
}

32
R/sir.R
View File

@ -741,6 +741,10 @@ as_sir_method <- function(method_short,
check_reference_data(reference_data, .call_depth = -2)
meet_criteria(breakpoint_type, allow_class = "character", is_in = reference_data$type, has_length = 1, .call_depth = -2)
if (message_not_thrown_before("as.sir", "sir_interpretation_history")) {
message_("Run `sir_interpretation_history()` afterwards to retrieve a logbook with all the details of the breakpoint interpretations.\n\n")
}
# for dplyr's across()
cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE)
if (!is.null(cur_column_dplyr) && tryCatch(is.data.frame(get_current_data("ab", call = 0)), error = function(e) FALSE)) {
@ -879,7 +883,7 @@ as_sir_method <- function(method_short,
rise_warning <- FALSE
rise_note <- FALSE
method_coerced <- toupper(method)
ab_coerced <- ab
ab_coerced <- as.ab(ab)
if (identical(reference_data, AMR::clinical_breakpoints)) {
breakpoints <- reference_data %pm>%
@ -945,10 +949,10 @@ as_sir_method <- function(method_short,
new_sir <- rep(NA_sir_, length(rows))
# find different mo properties, as fast as possible
mo_current_genus <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$genus[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$genus)]
mo_current_family <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$family[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$family)]
mo_current_order <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$order[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$order)]
mo_current_class <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$class[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$class)]
mo_current_genus <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$genus[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$fullname)]
mo_current_family <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$family[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$fullname)]
mo_current_order <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$order[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$fullname)]
mo_current_class <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$class[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$fullname)]
mo_current_rank <- AMR_env$MO_lookup$rank[match(mo_current, AMR_env$MO_lookup$mo)]
mo_current_name <- AMR_env$MO_lookup$fullname[match(mo_current, AMR_env$MO_lookup$mo)]
if (mo_current %in% AMR::microorganisms.groups$mo) {
@ -1064,17 +1068,17 @@ as_sir_method <- function(method_short,
data.frame(
datetime = rep(Sys.time(), length(rows)),
index = rows,
ab_input = rep(ab.bak, length(rows)),
ab_guideline = rep(ab_coerced, length(rows)),
mo_input = rep(mo.bak[match(mo_current, df$mo)][1], length(rows)),
mo_guideline = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)),
ab_user = rep(ab.bak, length(rows)),
mo_user = rep(mo.bak[match(mo_current, df$mo)][1], length(rows)),
ab = rep(ab_coerced, length(rows)),
mo = rep(breakpoints_current[, "mo", drop = TRUE], length(rows)),
input = as.double(values),
outcome = as.sir(new_sir),
method = rep(method_coerced, length(rows)),
breakpoint_S_R = rep(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
guideline = rep(guideline_coerced, length(rows)),
ref_table = rep(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)),
uti = rep(breakpoints_current[, "uti", drop = TRUE], length(rows)),
method = rep(method_coerced, length(rows)),
input = as.double(values),
outcome = as.sir(new_sir),
breakpoint_S_R = rep(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
stringsAsFactors = FALSE
)
)
@ -1114,8 +1118,6 @@ sir_interpretation_history <- function(clean = FALSE) {
message_("No results to return. Run `as.sir()` on MIC values or disk diffusion zones first to see a 'logbook' data set here.")
return(invisible(NULL))
}
out$ab_guideline <- as.ab(out$ab_guideline)
out$mo_guideline <- as.mo(out$mo_guideline)
out$outcome <- as.sir(out$outcome)
# keep stored for next use
if (isTRUE(clean)) {

BIN
R/sysdata.rda
View File

Binary file not shown.

15
R/zzz.R
View File

@ -58,18 +58,19 @@ AMR_env$av_previously_coerced <- data.frame(
AMR_env$sir_interpretation_history <- data.frame(
datetime = Sys.time()[0],
index = integer(0),
ab_input = character(0),
ab_guideline = set_clean_class(character(0), c("ab", "character")),
mo_input = character(0),
mo_guideline = set_clean_class(character(0), c("mo", "character")),
guideline = character(0),
ref_table = character(0),
method = character(0),
ab_user = character(0),
mo_user = character(0),
ab = set_clean_class(character(0), c("ab", "character")),
mo = set_clean_class(character(0), c("mo", "character")),
input = double(0),
outcome = NA_sir_[0],
method = character(0),
breakpoint_S_R = character(0),
guideline = character(0),
ref_table = character(0),
stringsAsFactors = FALSE
)
AMR_env$custom_ab_codes <- character(0)
AMR_env$custom_mo_codes <- character(0)
AMR_env$is_dark_theme <- NULL