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

(v2.1.1.9041) antibiotics update

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2024-06-08 17:35:25 +02:00
parent e2acc513a5
commit af74e1d4f2
26 changed files with 110 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
R/ab_selectors.R
View File

@ -367,9 +367,10 @@ glycopeptides <- function(only_sir_columns = FALSE, ...) {
#' @rdname antibiotic_class_selectors
#' @export
lincosamides <- function(only_sir_columns = FALSE, ...) {
lincosamides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("lincosamides", only_sir_columns = only_sir_columns)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_select_exec("lincosamides", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
}
#' @rdname antibiotic_class_selectors
@ -386,6 +387,13 @@ macrolides <- function(only_sir_columns = FALSE, ...) {
ab_select_exec("macrolides", only_sir_columns = only_sir_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
nitrofurans <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("nitrofurans", only_sir_columns = only_sir_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
oxazolidinones <- function(only_sir_columns = FALSE, ...) {
@ -410,16 +418,23 @@ polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
#' @rdname antibiotic_class_selectors
#' @export
streptogramins <- function(only_sir_columns = FALSE, ...) {
quinolones <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("streptogramins", only_sir_columns = only_sir_columns)
ab_select_exec("quinolones", only_sir_columns = only_sir_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
quinolones <- function(only_sir_columns = FALSE, ...) {
rifamycins <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("quinolones", only_sir_columns = only_sir_columns)
ab_select_exec("rifamycins", only_sir_columns = only_sir_columns)
}
#' @rdname antibiotic_class_selectors
#' @export
streptogramins <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("streptogramins", only_sir_columns = only_sir_columns)
}
#' @rdname antibiotic_class_selectors
@ -579,9 +594,9 @@ ab_select_exec <- function(function_name,
# untreatable drugs
if (only_treatable == TRUE) {
untreatable <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
untreatable <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$name %like% "-high|EDTA|polysorbate|macromethod|screening|nacubactam"), "ab", drop = TRUE]
if (any(untreatable %in% names(ab_in_data))) {
if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) {
if (message_not_thrown_before(function_name, "ab_class", "untreatable")) {
warning_(
"in `", function_name, "()`: some drugs were ignored since they cannot be used for treating patients: ",
vector_and(
@ -591,8 +606,7 @@ ab_select_exec <- function(function_name,
),
quotes = FALSE,
sort = TRUE
), ". They can be included using `", function_name, "(only_treatable = FALSE)`. ",
"This warning will be shown once per session."
), ". They can be included using `", function_name, "(only_treatable = FALSE)`."
)
}
ab_in_data <- ab_in_data[!names(ab_in_data) %in% untreatable]

11
R/mic.R
View File

@ -43,6 +43,9 @@ VALID_MIC_LEVELS <- c(t(vapply(FUN.VALUE = character(length(VALID_MIC_LEVELS)),
c("<", "<=", "", ">=", ">"),
paste0,
VALID_MIC_LEVELS)))
COMMON_MIC_VALUES <- c(0.001, 0.002, 0.004, 0.008, 0.016, 0.032, 0.064,
0.125, 0.25, 0.5, 1, 2, 4, 8, 16, 32,
64, 128, 256, 512, 1024)
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
#'
@ -300,10 +303,10 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
}
# create a manual factor with levels only within desired range
expanded <- range_as_table(x,
expand = TRUE,
keep_operators = ifelse(keep_operators == "edges", "none", keep_operators),
mic_range = mic_range)
expanded <- plotrange_as_table(x,
expand = TRUE,
keep_operators = ifelse(keep_operators == "edges", "none", keep_operators),
mic_range = mic_range)
if (keep_operators == "edges") {
names(expanded)[1] <- paste0("<=", names(expanded)[1])
names(expanded)[length(expanded)] <- paste0(">=", names(expanded)[length(expanded)])

33
R/plot.R
View File

@ -195,7 +195,7 @@ plot.mic <- function(x,
}
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- range_as_table(x, expand = expand)
x <- plotrange_as_table(x, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -327,7 +327,7 @@ autoplot.mic <- function(object,
}
object <- as.mic(object) # make sure that currently implemented MIC levels are used
x <- range_as_table(object, expand = expand)
x <- plotrange_as_table(object, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -392,7 +392,7 @@ autoplot.mic <- function(object,
fortify.mic <- function(object, ...) {
object <- as.mic(object) # make sure that currently implemented MIC levels are used
stats::setNames(
as.data.frame(range_as_table(object, expand = FALSE)),
as.data.frame(plotrange_as_table(object, expand = FALSE)),
c("x", "y")
)
}
@ -430,7 +430,7 @@ plot.disk <- function(x,
}
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- range_as_table(x, expand = expand)
x <- plotrange_as_table(x, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -559,7 +559,7 @@ autoplot.disk <- function(object,
title <- gsub(" +", " ", paste0(title, collapse = " "))
}
x <- range_as_table(object, expand = expand)
x <- plotrange_as_table(object, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -624,7 +624,7 @@ autoplot.disk <- function(object,
# will be exported using s3_register() in R/zzz.R
fortify.disk <- function(object, ...) {
stats::setNames(
as.data.frame(range_as_table(object, expand = FALSE)),
as.data.frame(plotrange_as_table(object, expand = FALSE)),
c("x", "y")
)
}
@ -789,26 +789,15 @@ fortify.sir <- function(object, ...) {
)
}
range_as_table <- function(x, expand, keep_operators = "all", mic_range = NULL) {
plotrange_as_table <- function(x, expand, keep_operators = "all", mic_range = NULL) {
x <- x[!is.na(x)]
if (is.mic(x)) {
x <- as.mic(x, keep_operators = keep_operators)
if (expand == TRUE) {
# expand range for MIC by adding factors of 2 from lowest to highest so all MICs in between also print
extra_range <- max(x)
min_range <- min(x)
if (!is.null(mic_range)) {
if (!is.na(mic_range[2])) {
extra_range <- as.mic(mic_range[2]) * 2
}
if (!is.na(mic_range[1])) {
min_range <- as.mic(mic_range[1])
}
}
extra_range <- extra_range / 2
while (min(extra_range) / 2 > min_range) {
extra_range <- c(min(extra_range) / 2, extra_range)
}
# expand range for MIC by adding common intermediate factors levels
extra_range <- COMMON_MIC_VALUES[COMMON_MIC_VALUES > min(x, na.rm = TRUE) & COMMON_MIC_VALUES < max(x, na.rm = TRUE)]
# remove the ones that are in 25% range of user values
extra_range <- extra_range[!vapply(FUN.VALUE = logical(1), extra_range, function(r) any(abs(r - x) / x < 0.25, na.rm = TRUE))]
nms <- extra_range
extra_range <- rep(0, length(extra_range))
names(extra_range) <- nms

BIN
R/sysdata.rda
View File

Binary file not shown.

1
R/translate.R
View File

@ -244,6 +244,7 @@ translate_into_language <- function(from,
# starting with longest pattern, since more general translations are shorter, such as 'Group'
order(nchar(df_trans$pattern), decreasing = TRUE),
function(i) {
if (df_trans$pattern[i] %like% "[/]") return(df_trans$pattern[i])
from_unique_translated <<- gsub(
pattern = df_trans$pattern[i],
replacement = df_trans[i, lang, drop = TRUE],