P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-27 14:06:12 +01:00
Code Releases Activity

cleanup

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-07-11 14:29:40 +02:00
parent 8df1cd8d97
commit 66eeeb4b88
6 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 2.0.0.9034 Version: 2.0.0.9035
Date: 2023-07-11 Date: 2023-07-11
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 2.0.0.9034 # AMR 2.0.0.9035
## New ## New
* Clinical breakpoints and intrinsic resistance of EUCAST 2023 and CLSI 2023 have been added for `as.sir()`. EUCAST 2023 (v13.0) is now the new default guideline for all MIC and disks diffusion interpretations * Clinical breakpoints and intrinsic resistance of EUCAST 2023 and CLSI 2023 have been added for `as.sir()`. EUCAST 2023 (v13.0) is now the new default guideline for all MIC and disks diffusion interpretations

2
R/ab.R
View File

@ -548,7 +548,7 @@ pillar_shaft.ab <- function(x, ...) {
# add the names to the drugs as mouse-over! # add the names to the drugs as mouse-over!
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) { 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), out[!is.na(x)] <- font_url(url = ab_name(x[!is.na(x)]),
txt = out[!is.na(x)]) txt = out[!is.na(x)])
} }

2
R/disk.R
View File

@ -70,7 +70,7 @@
#' # interpret whole data set, pretend to be all from urinary tract infections: #' # interpret whole data set, pretend to be all from urinary tract infections:
#' as.sir(df, uti = TRUE) #' as.sir(df, uti = TRUE)
as.disk <- function(x, na.rm = FALSE) { as.disk <- function(x, na.rm = FALSE) {
meet_criteria(x, allow_class = c("disk", "character", "numeric", "integer"), allow_NA = TRUE) meet_criteria(x, allow_NA = TRUE)
meet_criteria(na.rm, allow_class = "logical", has_length = 1) meet_criteria(na.rm, allow_class = "logical", has_length = 1)
if (!is.disk(x)) { if (!is.disk(x)) {

2
R/mo.R
View File

@ -630,7 +630,7 @@ pillar_shaft.mo <- function(x, ...) {
# add the names to the bugs as mouse-over! # add the names to the bugs as mouse-over!
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) { if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
out[!x %in% c("UNKNOWN", NA)] <- font_url(url = mo_name(x[!x %in% c("UNKNOWN", NA)], language = NULL, keep_synonyms = TRUE), out[!x %in% c("UNKNOWN", NA)] <- font_url(url = mo_name(x[!x %in% c("UNKNOWN", NA)], keep_synonyms = TRUE),
txt = out[!x %in% c("UNKNOWN", NA)]) txt = out[!x %in% c("UNKNOWN", NA)])
} }

14
R/sir.R
View File

@ -741,8 +741,10 @@ as_sir_method <- function(method_short,
check_reference_data(reference_data, .call_depth = -2) 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) meet_criteria(breakpoint_type, allow_class = "character", is_in = reference_data$type, has_length = 1, .call_depth = -2)
guideline_coerced <- get_guideline(guideline, reference_data)
if (message_not_thrown_before("as.sir", "sir_interpretation_history")) { 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") message_("Run `sir_interpretation_history()` afterwards to retrieve a logbook with all the details of the breakpoint interpretations. Note that some microorganisms might not have breakpoints for each antimicrobial drug in ", guideline_coerced, ".\n\n")
} }
# for dplyr's across() # for dplyr's across()
@ -798,7 +800,6 @@ as_sir_method <- function(method_short,
} }
# be sure to take current taxonomy, as the 'clinical_breakpoints' data set only contains current taxonomy # be sure to take current taxonomy, as the 'clinical_breakpoints' data set only contains current taxonomy
mo <- suppressWarnings(suppressMessages(as.mo(mo, keep_synonyms = FALSE, info = FALSE))) mo <- suppressWarnings(suppressMessages(as.mo(mo, keep_synonyms = FALSE, info = FALSE)))
guideline_coerced <- get_guideline(guideline, reference_data)
if (is.na(ab)) { if (is.na(ab)) {
message_("Returning NAs for unknown antibiotic: '", font_bold(ab.bak), message_("Returning NAs for unknown antibiotic: '", font_bold(ab.bak),
"'. Rename this column to a valid name or code, and check the output with `as.ab()`.", "'. Rename this column to a valid name or code, and check the output with `as.ab()`.",
@ -919,7 +920,7 @@ as_sir_method <- function(method_short,
paste0(font_rose_bg(" WARNING "), "\n"), paste0(font_rose_bg(" WARNING "), "\n"),
font_black(paste0(" ", AMR_env$bullet_icon, " No ", method_coerced, " breakpoints available for ", font_black(paste0(" ", AMR_env$bullet_icon, " No ", method_coerced, " breakpoints available for ",
suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))), suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
" (", ab_coerced, ")"))) " (", ab_coerced, ").")))
load_mo_uncertainties(metadata_mo) load_mo_uncertainties(metadata_mo)
return(rep(NA_sir_, nrow(df))) return(rep(NA_sir_, nrow(df)))
@ -1017,6 +1018,9 @@ as_sir_method <- function(method_short,
} else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && all(breakpoints_current$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteOther", mo_current, ab_coerced)) { } else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && all(breakpoints_current$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteOther", mo_current, ab_coerced)) {
# breakpoints for multiple body sites available # breakpoints for multiple body sites available
msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ".")) msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, "."))
} else if (nrow(breakpoints_current) == 0) {
# # do not note - it's already in the header before the interpretation starts
next
} }
# first check if mo is intrinsic resistant # first check if mo is intrinsic resistant
@ -1031,10 +1035,10 @@ as_sir_method <- function(method_short,
breakpoints_current <- breakpoints_current[1L, , drop = FALSE] breakpoints_current <- breakpoints_current[1L, , drop = FALSE]
if (any(breakpoints_current$mo == "UNKNOWN", na.rm = TRUE) | any(breakpoints_current$ref_tbl %like% "PK.*PD", na.rm = TRUE)) { if (any(breakpoints_current$mo == "UNKNOWN", na.rm = TRUE) | any(breakpoints_current$ref_tbl %like% "PK.*PD", na.rm = TRUE)) {
msgs <- c(msgs, "(Some) PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this") msgs <- c(msgs, "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this")
} }
if (any(breakpoints_current$site %like% "screen", na.rm = TRUE) | any(breakpoints_current$ref_tbl %like% "screen", na.rm = TRUE)) { if (any(breakpoints_current$site %like% "screen", na.rm = TRUE) | any(breakpoints_current$ref_tbl %like% "screen", na.rm = TRUE)) {
msgs <- c(msgs, "(Some) screening breakpoints were applied - use `include_screening = FALSE` to prevent this") msgs <- c(msgs, "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this")
} }
if (method == "mic") { if (method == "mic") {