1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 18:06:12 +01:00

support ab selectors for manual AB codes

This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-10-11 10:49:55 +02:00
parent 955f9d7020
commit 33227a5d90
6 changed files with 84 additions and 21 deletions

View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.8.2.9012
Date: 2022-10-10
Version: 1.8.2.9013
Date: 2022-10-11
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by

View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9012
# AMR 1.8.2.9013
This version will eventually become v2.0! We're happy to reach a new major milestone soon!

View File

@ -216,7 +216,7 @@ ab_selector <- function(filter,
sort = FALSE, fn = "ab_selector"
)
call <- substitute(filter)
agents <- tryCatch(AMR::antibiotics[which(eval(call, envir = AMR::antibiotics)), "ab", drop = TRUE],
agents <- tryCatch(AB_lookup[which(eval(call, envir = AB_lookup)), "ab", drop = TRUE],
error = function(e) stop_(e$message, call = -5)
)
agents <- ab_in_data[ab_in_data %in% agents]
@ -424,8 +424,8 @@ administrable_per_os <- function(only_rsi_columns = FALSE, ...) {
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = "administrable_per_os"
)
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE]
agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE]
agents_all <- AB_lookup[which(!is.na(AB_lookup$oral_ddd)), "ab", drop = TRUE]
agents <- AB_lookup[which(AB_lookup$ab %in% ab_in_data & !is.na(AB_lookup$oral_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
function_name = "administrable_per_os",
@ -462,8 +462,8 @@ administrable_iv <- function(only_rsi_columns = FALSE, ...) {
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = "administrable_iv"
)
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE]
agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE]
agents_all <- AB_lookup[which(!is.na(AB_lookup$iv_ddd)), "ab", drop = TRUE]
agents <- AB_lookup[which(AB_lookup$ab %in% ab_in_data & !is.na(AB_lookup$iv_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
function_name = "administrable_iv",
@ -541,9 +541,10 @@ ab_select_exec <- function(function_name,
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = function_name
)
# untreatable drugs
if (only_treatable == TRUE) {
untreatable <- AMR::antibiotics[which(AMR::antibiotics$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
untreatable <- AB_lookup[which(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)) {
warning_(
@ -570,13 +571,26 @@ ab_select_exec <- function(function_name,
if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
ab_group <- NULL
if (isTRUE(function_name == "antifungals")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antifungals")]
abx <- AB_lookup$ab[which(AB_lookup$group == "Antifungals")]
} else if (isTRUE(function_name == "antimycobacterials")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antimycobacterials")]
abx <- AB_lookup$ab[which(AB_lookup$group == "Antimycobacterials")]
} else {
# their upper case equivalent are vectors with class <ab>, created in data-raw/_pre_commit_hook.R
# carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
abx <- get(paste0("AB_", toupper(function_name)), envir = asNamespace("AMR"))
# manually added codes from add_custom_antimicrobials() must also be supported
if (length(AMR_env$custom_ab_codes) > 0) {
custom_ab <- AB_lookup[which(AB_lookup$ab %in% AMR_env$custom_ab_codes), ]
check_string <- paste0(custom_ab$group, custom_ab$atc_group1, custom_ab$atc_group2)
if (function_name == "betalactams") {
find_group <- "beta-lactams"
} else if (function_name %like% "cephalosporins_") {
find_group <- gsub("_(.*)$", paste0(" (\\1 gen.)"), function_name)
} else {
find_group <- function_name
}
abx <- c(abx, custom_ab$ab[which(check_string %like% find_group)])
}
ab_group <- function_name
}
examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
@ -793,16 +807,16 @@ find_ab_names <- function(ab_group, n = 3) {
ab_group <- gsub("[^a-zA-Z|0-9]", ".*", ab_group)
# try popular first, they have DDDs
drugs <- AMR::antibiotics[which((!is.na(AMR::antibiotics$iv_ddd) | !is.na(AMR::antibiotics$oral_ddd)) &
AMR::antibiotics$name %unlike% " " &
AMR::antibiotics$group %like% ab_group &
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
drugs <- AB_lookup[which((!is.na(AB_lookup$iv_ddd) | !is.na(AB_lookup$oral_ddd)) &
AB_lookup$name %unlike% " " &
AB_lookup$group %like% ab_group &
AB_lookup$ab %unlike% "[0-9]$"), ]$name
if (length(drugs) < n) {
# now try it all
drugs <- antibiotics[which((AMR::antibiotics$group %like% ab_group |
AMR::antibiotics$atc_group1 %like% ab_group |
AMR::antibiotics$atc_group2 %like% ab_group) &
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
drugs <- AB_lookup[which((AB_lookup$group %like% ab_group |
AB_lookup$atc_group1 %like% ab_group |
AB_lookup$atc_group2 %like% ab_group) &
AB_lookup$ab %unlike% "[0-9]$"), ]$name
}
if (length(drugs) == 0) {
return("??")

View File

@ -69,6 +69,25 @@
#' ab_group("test")
#'
#' ab_info("test")
#'
#'
#' # Add Co-fluampicil, which is one of the many J01CR50 codes, see
#' # https://www.whocc.no/ddd/list_of_ddds_combined_products/
#' add_custom_antimicrobials(
#' data.frame(ab = "COFLU",
#' name = "Co-fluampicil",
#' atc = "J01CR50",
#' group = "Beta-lactams/penicillines")
#' )
#' ab_atc("Co-fluampicil")
#' ab_name("J01CR50")
#'
#' # even antibiotic selectors work
#' x <- data.frame(random_column = "test",
#' coflu = as.rsi("S"),
#' ampicillin = as.rsi("R"))
#' x
#' x[, betalactams()]
add_custom_antimicrobials <- function(x) {
meet_criteria(x, allow_class = "data.frame")
stop_ifnot(all(c("ab", "name") %in% colnames(x)),
@ -79,18 +98,27 @@ add_custom_antimicrobials <- function(x) {
x <- x[, colnames(AB_lookup)[colnames(AB_lookup) %in% colnames(x)], drop = FALSE]
x$generalised_name <- generalise_antibiotic_name(x$name)
x$generalised_all <- as.list(x$generalised_name)
if ("atc" %in% colnames(x)) {
x$atc <- as.list(x$atc)
}
if ("loinc" %in% colnames(x)) {
x$loinc <- as.list(x$loinc)
}
AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab)
bind_rows <- import_fn("bind_rows", "dplyr", error_on_fail = FALSE)
if (!is.null(bind_rows)) {
new_df <- bind_rows(AB_lookup, x)
} else {
new_df <- rbind(AB_lookup, x, stringsAsFactors = FALSE)
new_df <- tryCatch(rbind(AB_lookup, x, stringsAsFactors = FALSE),
error = function(x) stop("Error while adding antimicrobials. Try installing the 'dplyr' package for extended support.", call. = FALSE))
}
new_df <- unique(new_df)
assignInNamespace(x = "AB_lookup",
value = new_df,
ns = asNamespace("AMR"))
message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to internal `antibiotics` data set.")
message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antibiotics` data set.")
}
#' @rdname add_custom_antimicrobials
@ -99,5 +127,6 @@ clear_custom_antimicrobials <- function() {
assignInNamespace(x = "AB_lookup",
value = create_AB_lookup(),
ns = asNamespace("AMR"))
AMR_env$custom_ab_codes <- character(0)
message_("Manual antimicrobials cleared.")
}

View File

@ -67,6 +67,7 @@ AMR_env$rsi_interpretation_history <- data.frame(
stringsAsFactors = FALSE
)
AMR_env$has_data.table <- pkg_is_available("data.table", also_load = FALSE)
AMR_env$custom_ab_codes <- character(0)
# determine info icon for messages
utf8_supported <- isTRUE(base::l10n_info()$`UTF-8`)

View File

@ -52,4 +52,23 @@ ab_name("test")
ab_group("test")
ab_info("test")
# Add Co-fluampicil, which is one of the many J01CR50 codes, see
# https://www.whocc.no/ddd/list_of_ddds_combined_products/
add_custom_antimicrobials(
data.frame(ab = "COFLU",
name = "Co-fluampicil",
atc = "J01CR50",
group = "Beta-lactams/penicillines")
)
ab_atc("Co-fluampicil")
ab_name("J01CR50")
# even antibiotic selectors work
x <- data.frame(random_column = "test",
coflu = as.rsi("S"),
ampicillin = as.rsi("R"))
x
x[, betalactams()]
}