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:
parent
955f9d7020
commit
33227a5d90
@ -1,6 +1,6 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 1.8.2.9012
|
Version: 1.8.2.9013
|
||||||
Date: 2022-10-10
|
Date: 2022-10-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)
|
||||||
data analysis and to work with microbial and antimicrobial properties by
|
data analysis and to work with microbial and antimicrobial properties by
|
||||||
|
2
NEWS.md
2
NEWS.md
@ -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!
|
This version will eventually become v2.0! We're happy to reach a new major milestone soon!
|
||||||
|
|
||||||
|
@ -216,7 +216,7 @@ ab_selector <- function(filter,
|
|||||||
sort = FALSE, fn = "ab_selector"
|
sort = FALSE, fn = "ab_selector"
|
||||||
)
|
)
|
||||||
call <- substitute(filter)
|
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)
|
error = function(e) stop_(e$message, call = -5)
|
||||||
)
|
)
|
||||||
agents <- ab_in_data[ab_in_data %in% agents]
|
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,
|
info = FALSE, only_rsi_columns = only_rsi_columns,
|
||||||
sort = FALSE, fn = "administrable_per_os"
|
sort = FALSE, fn = "administrable_per_os"
|
||||||
)
|
)
|
||||||
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE]
|
agents_all <- AB_lookup[which(!is.na(AB_lookup$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 <- 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]
|
agents <- ab_in_data[ab_in_data %in% agents]
|
||||||
message_agent_names(
|
message_agent_names(
|
||||||
function_name = "administrable_per_os",
|
function_name = "administrable_per_os",
|
||||||
@ -462,8 +462,8 @@ administrable_iv <- function(only_rsi_columns = FALSE, ...) {
|
|||||||
info = FALSE, only_rsi_columns = only_rsi_columns,
|
info = FALSE, only_rsi_columns = only_rsi_columns,
|
||||||
sort = FALSE, fn = "administrable_iv"
|
sort = FALSE, fn = "administrable_iv"
|
||||||
)
|
)
|
||||||
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE]
|
agents_all <- AB_lookup[which(!is.na(AB_lookup$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 <- 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]
|
agents <- ab_in_data[ab_in_data %in% agents]
|
||||||
message_agent_names(
|
message_agent_names(
|
||||||
function_name = "administrable_iv",
|
function_name = "administrable_iv",
|
||||||
@ -541,9 +541,10 @@ ab_select_exec <- function(function_name,
|
|||||||
info = FALSE, only_rsi_columns = only_rsi_columns,
|
info = FALSE, only_rsi_columns = only_rsi_columns,
|
||||||
sort = FALSE, fn = function_name
|
sort = FALSE, fn = function_name
|
||||||
)
|
)
|
||||||
|
|
||||||
# untreatable drugs
|
# untreatable drugs
|
||||||
if (only_treatable == TRUE) {
|
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 (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", entire_session = TRUE)) {
|
||||||
warning_(
|
warning_(
|
||||||
@ -570,13 +571,26 @@ ab_select_exec <- function(function_name,
|
|||||||
if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
|
if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
|
||||||
ab_group <- NULL
|
ab_group <- NULL
|
||||||
if (isTRUE(function_name == "antifungals")) {
|
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")) {
|
} else if (isTRUE(function_name == "antimycobacterials")) {
|
||||||
abx <- antibiotics$ab[which(antibiotics$group == "Antimycobacterials")]
|
abx <- AB_lookup$ab[which(AB_lookup$group == "Antimycobacterials")]
|
||||||
} else {
|
} else {
|
||||||
# their upper case equivalent are vectors with class <ab>, created in data-raw/_pre_commit_hook.R
|
# 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
|
# carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
|
||||||
abx <- get(paste0("AB_", toupper(function_name)), envir = asNamespace("AMR"))
|
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
|
ab_group <- function_name
|
||||||
}
|
}
|
||||||
examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
|
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)
|
ab_group <- gsub("[^a-zA-Z|0-9]", ".*", ab_group)
|
||||||
|
|
||||||
# try popular first, they have DDDs
|
# try popular first, they have DDDs
|
||||||
drugs <- AMR::antibiotics[which((!is.na(AMR::antibiotics$iv_ddd) | !is.na(AMR::antibiotics$oral_ddd)) &
|
drugs <- AB_lookup[which((!is.na(AB_lookup$iv_ddd) | !is.na(AB_lookup$oral_ddd)) &
|
||||||
AMR::antibiotics$name %unlike% " " &
|
AB_lookup$name %unlike% " " &
|
||||||
AMR::antibiotics$group %like% ab_group &
|
AB_lookup$group %like% ab_group &
|
||||||
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
|
AB_lookup$ab %unlike% "[0-9]$"), ]$name
|
||||||
if (length(drugs) < n) {
|
if (length(drugs) < n) {
|
||||||
# now try it all
|
# now try it all
|
||||||
drugs <- antibiotics[which((AMR::antibiotics$group %like% ab_group |
|
drugs <- AB_lookup[which((AB_lookup$group %like% ab_group |
|
||||||
AMR::antibiotics$atc_group1 %like% ab_group |
|
AB_lookup$atc_group1 %like% ab_group |
|
||||||
AMR::antibiotics$atc_group2 %like% ab_group) &
|
AB_lookup$atc_group2 %like% ab_group) &
|
||||||
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
|
AB_lookup$ab %unlike% "[0-9]$"), ]$name
|
||||||
}
|
}
|
||||||
if (length(drugs) == 0) {
|
if (length(drugs) == 0) {
|
||||||
return("??")
|
return("??")
|
||||||
|
@ -69,6 +69,25 @@
|
|||||||
#' ab_group("test")
|
#' ab_group("test")
|
||||||
#'
|
#'
|
||||||
#' ab_info("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) {
|
add_custom_antimicrobials <- function(x) {
|
||||||
meet_criteria(x, allow_class = "data.frame")
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
stop_ifnot(all(c("ab", "name") %in% colnames(x)),
|
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 <- x[, colnames(AB_lookup)[colnames(AB_lookup) %in% colnames(x)], drop = FALSE]
|
||||||
x$generalised_name <- generalise_antibiotic_name(x$name)
|
x$generalised_name <- generalise_antibiotic_name(x$name)
|
||||||
x$generalised_all <- as.list(x$generalised_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)
|
bind_rows <- import_fn("bind_rows", "dplyr", error_on_fail = FALSE)
|
||||||
if (!is.null(bind_rows)) {
|
if (!is.null(bind_rows)) {
|
||||||
new_df <- bind_rows(AB_lookup, x)
|
new_df <- bind_rows(AB_lookup, x)
|
||||||
} else {
|
} 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",
|
assignInNamespace(x = "AB_lookup",
|
||||||
value = new_df,
|
value = new_df,
|
||||||
ns = asNamespace("AMR"))
|
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
|
#' @rdname add_custom_antimicrobials
|
||||||
@ -99,5 +127,6 @@ clear_custom_antimicrobials <- function() {
|
|||||||
assignInNamespace(x = "AB_lookup",
|
assignInNamespace(x = "AB_lookup",
|
||||||
value = create_AB_lookup(),
|
value = create_AB_lookup(),
|
||||||
ns = asNamespace("AMR"))
|
ns = asNamespace("AMR"))
|
||||||
|
AMR_env$custom_ab_codes <- character(0)
|
||||||
message_("Manual antimicrobials cleared.")
|
message_("Manual antimicrobials cleared.")
|
||||||
}
|
}
|
||||||
|
1
R/zzz.R
1
R/zzz.R
@ -67,6 +67,7 @@ AMR_env$rsi_interpretation_history <- data.frame(
|
|||||||
stringsAsFactors = FALSE
|
stringsAsFactors = FALSE
|
||||||
)
|
)
|
||||||
AMR_env$has_data.table <- pkg_is_available("data.table", also_load = 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
|
# determine info icon for messages
|
||||||
utf8_supported <- isTRUE(base::l10n_info()$`UTF-8`)
|
utf8_supported <- isTRUE(base::l10n_info()$`UTF-8`)
|
||||||
|
@ -52,4 +52,23 @@ ab_name("test")
|
|||||||
ab_group("test")
|
ab_group("test")
|
||||||
|
|
||||||
ab_info("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()]
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user