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

move object assignment to AMR_env

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-10-14 13:02:50 +02:00
parent dfae4c7e7d
commit 76bcd3528c
18 changed files with 116 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 1.8.2.9014 Version: 1.8.2.9016
Date: 2022-10-11 Date: 2022-10-14
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
View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9014 # AMR 1.8.2.9016
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!

2
R/aa_helper_functions.R
View File

@ -626,7 +626,7 @@ create_eucast_ab_documentation <- function() {
if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) { if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
# antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `CARBAPENEMS` # antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `CARBAPENEMS`
val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR")) val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR"))
} else if (val %in% AB_lookup$ab) { } else if (val %in% AMR_env$AB_lookup$ab) {
# separate drugs, such as `AMX` # separate drugs, such as `AMX`
val <- as.ab(val) val <- as.ab(val)
} else { } else {

50
R/ab.R
View File

@ -100,7 +100,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
if (is.ab(x)) { if (is.ab(x)) {
return(x) return(x)
} }
if (all(x %in% c(AB_lookup$ab, NA))) { if (all(x %in% c(AMR_env$AB_lookup$ab, NA))) {
# all valid AB codes, but not yet right class # all valid AB codes, but not yet right class
return(set_clean_class(x, return(set_clean_class(x,
new_class = c("ab", "character") new_class = c("ab", "character")
@ -147,25 +147,25 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
} }
# Fill in names, AB codes, CID codes and ATC codes directly (`x` is already clean and uppercase) # Fill in names, AB codes, CID codes and ATC codes directly (`x` is already clean and uppercase)
known_names <- x %in% AB_lookup$generalised_name known_names <- x %in% AMR_env$AB_lookup$generalised_name
x_new[known_names] <- AB_lookup$ab[match(x[known_names], AB_lookup$generalised_name)] x_new[known_names] <- AMR_env$AB_lookup$ab[match(x[known_names], AMR_env$AB_lookup$generalised_name)]
known_codes_ab <- x %in% AB_lookup$ab known_codes_ab <- x %in% AMR_env$AB_lookup$ab
known_codes_atc <- vapply(FUN.VALUE = logical(1), x, function(x_) x_ %in% unlist(AB_lookup$atc), USE.NAMES = FALSE) known_codes_atc <- vapply(FUN.VALUE = logical(1), x, function(x_) x_ %in% unlist(AMR_env$AB_lookup$atc), USE.NAMES = FALSE)
known_codes_cid <- x %in% AB_lookup$cid known_codes_cid <- x %in% AMR_env$AB_lookup$cid
x_new[known_codes_ab] <- AB_lookup$ab[match(x[known_codes_ab], AB_lookup$ab)] x_new[known_codes_ab] <- AMR_env$AB_lookup$ab[match(x[known_codes_ab], AMR_env$AB_lookup$ab)]
x_new[known_codes_atc] <- AB_lookup$ab[vapply( x_new[known_codes_atc] <- AMR_env$AB_lookup$ab[vapply(
FUN.VALUE = integer(1), FUN.VALUE = integer(1),
x[known_codes_atc], x[known_codes_atc],
function(x_) { function(x_) {
which(vapply( which(vapply(
FUN.VALUE = logical(1), FUN.VALUE = logical(1),
AB_lookup$atc, AMR_env$AB_lookup$atc,
function(atc) x_ %in% atc function(atc) x_ %in% atc
))[1L] ))[1L]
}, },
USE.NAMES = FALSE USE.NAMES = FALSE
)] )]
x_new[known_codes_cid] <- AB_lookup$ab[match(x[known_codes_cid], AB_lookup$cid)] x_new[known_codes_cid] <- AMR_env$AB_lookup$ab[match(x[known_codes_cid], AMR_env$AB_lookup$cid)]
previously_coerced <- x %in% AMR_env$ab_previously_coerced$x previously_coerced <- x %in% AMR_env$ab_previously_coerced$x
x_new[previously_coerced & is.na(x_new)] <- AMR_env$ab_previously_coerced$ab[match(x[is.na(x_new) & x %in% AMR_env$ab_previously_coerced$x], AMR_env$ab_previously_coerced$x)] x_new[previously_coerced & is.na(x_new)] <- AMR_env$ab_previously_coerced$ab[match(x[is.na(x_new) & x %in% AMR_env$ab_previously_coerced$x], AMR_env$ab_previously_coerced$x)]
already_known <- known_names | known_codes_ab | known_codes_atc | known_codes_cid | previously_coerced already_known <- known_names | known_codes_ab | known_codes_atc | known_codes_cid | previously_coerced
@ -217,10 +217,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# exact LOINC code # exact LOINC code
loinc_found <- unlist(lapply( loinc_found <- unlist(lapply(
AB_lookup$generalised_loinc, AMR_env$AB_lookup$generalised_loinc,
function(s) x[i] %in% s function(s) x[i] %in% s
)) ))
found <- AB_lookup$ab[loinc_found == TRUE] found <- AMR_env$AB_lookup$ab[loinc_found == TRUE]
if (length(found) > 0) { if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text) x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next next
@ -228,10 +228,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# exact synonym # exact synonym
synonym_found <- unlist(lapply( synonym_found <- unlist(lapply(
AB_lookup$generalised_synonyms, AMR_env$AB_lookup$generalised_synonyms,
function(s) x[i] %in% s function(s) x[i] %in% s
)) ))
found <- AB_lookup$ab[synonym_found == TRUE] found <- AMR_env$AB_lookup$ab[synonym_found == TRUE]
if (length(found) > 0) { if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text) x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next next
@ -239,11 +239,11 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# exact abbreviation # exact abbreviation
abbr_found <- unlist(lapply( abbr_found <- unlist(lapply(
AB_lookup$generalised_abbreviations, AMR_env$AB_lookup$generalised_abbreviations,
# require at least 2 characters for abbreviations # require at least 2 characters for abbreviations
function(s) x[i] %in% s && nchar(x[i]) >= 2 function(s) x[i] %in% s && nchar(x[i]) >= 2
)) ))
found <- AB_lookup$ab[abbr_found == TRUE] found <- AMR_env$AB_lookup$ab[abbr_found == TRUE]
if (length(found) > 0) { if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text) x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next next
@ -251,9 +251,9 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# length of input is quite long, and Levenshtein distance is only max 2 # length of input is quite long, and Levenshtein distance is only max 2
if (nchar(x[i]) >= 10) { if (nchar(x[i]) >= 10) {
levenshtein <- as.double(utils::adist(x[i], AB_lookup$generalised_name)) levenshtein <- as.double(utils::adist(x[i], AMR_env$AB_lookup$generalised_name))
if (any(levenshtein <= 2)) { if (any(levenshtein <= 2)) {
found <- AB_lookup$ab[which(levenshtein <= 2)] found <- AMR_env$AB_lookup$ab[which(levenshtein <= 2)]
x_new[i] <- note_if_more_than_one_found(found, i, from_text) x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next next
} }
@ -290,13 +290,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
} }
# try if name starts with it # try if name starts with it
found <- AB_lookup[which(AB_lookup$generalised_name %like% paste0("^", x_spelling)), "ab", drop = TRUE] found <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$generalised_name %like% paste0("^", x_spelling)), "ab", drop = TRUE]
if (length(found) > 0) { if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text) x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next next
} }
# try if name ends with it # try if name ends with it
found <- AB_lookup[which(AB_lookup$generalised_name %like% paste0(x_spelling, "$")), "ab", drop = TRUE] found <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$generalised_name %like% paste0(x_spelling, "$")), "ab", drop = TRUE]
if (nchar(x[i]) >= 4 && length(found) > 0) { if (nchar(x[i]) >= 4 && length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text) x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next next
@ -304,10 +304,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# and try if any synonym starts with it # and try if any synonym starts with it
synonym_found <- unlist(lapply( synonym_found <- unlist(lapply(
AB_lookup$generalised_synonyms, AMR_env$AB_lookup$generalised_synonyms,
function(s) any(s %like% paste0("^", x_spelling)) function(s) any(s %like% paste0("^", x_spelling))
)) ))
found <- AB_lookup$ab[synonym_found == TRUE] found <- AMR_env$AB_lookup$ab[synonym_found == TRUE]
if (length(found) > 0) { if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text) x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next next
@ -585,7 +585,7 @@ as.data.frame.ab <- function(x, ...) {
"[<-.ab" <- function(i, j, ..., value) { "[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod() y <- NextMethod()
attributes(y) <- attributes(i) attributes(y) <- attributes(i)
return_after_integrity_check(y, "antimicrobial code", AB_lookup$ab) return_after_integrity_check(y, "antimicrobial code", AMR_env$AB_lookup$ab)
} }
#' @method [[<- ab #' @method [[<- ab
#' @export #' @export
@ -593,7 +593,7 @@ as.data.frame.ab <- function(x, ...) {
"[[<-.ab" <- function(i, j, ..., value) { "[[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod() y <- NextMethod()
attributes(y) <- attributes(i) attributes(y) <- attributes(i)
return_after_integrity_check(y, "antimicrobial code", AB_lookup$ab) return_after_integrity_check(y, "antimicrobial code", AMR_env$AB_lookup$ab)
} }
#' @method c ab #' @method c ab
#' @export #' @export
@ -602,7 +602,7 @@ c.ab <- function(...) {
x <- list(...)[[1L]] x <- list(...)[[1L]]
y <- NextMethod() y <- NextMethod()
attributes(y) <- attributes(x) attributes(y) <- attributes(x)
return_after_integrity_check(y, "antimicrobial code", AB_lookup$ab) return_after_integrity_check(y, "antimicrobial code", AMR_env$AB_lookup$ab)
} }
#' @method unique ab #' @method unique ab

12
R/ab_property.R
View File

@ -452,22 +452,22 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
} }
ab_validate <- function(x, property, ...) { ab_validate <- function(x, property, ...) {
if (tryCatch(all(x[!is.na(x)] %in% AB_lookup$ab), error = function(e) FALSE)) { if (tryCatch(all(x[!is.na(x)] %in% AMR_env$AB_lookup$ab), error = function(e) FALSE)) {
# special case for ab_* functions where class is already <ab> # special case for ab_* functions where class is already <ab>
x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE] x <- AMR_env$AB_lookup[match(x, AMR_env$AB_lookup$ab), property, drop = TRUE]
} else { } else {
# try to catch an error when inputting an invalid argument # try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE # so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% AB_lookup[1, property, drop = TRUE], tryCatch(x[1L] %in% AMR_env$AB_lookup[1, property, drop = TRUE],
error = function(e) stop(e$message, call. = FALSE) error = function(e) stop(e$message, call. = FALSE)
) )
if (!all(x %in% AB_lookup[, property, drop = TRUE])) { if (!all(x %in% AMR_env$AB_lookup[, property, drop = TRUE])) {
x <- as.ab(x, ...) x <- as.ab(x, ...)
if (all(is.na(x)) && is.list(AB_lookup[, property, drop = TRUE])) { if (all(is.na(x)) && is.list(AMR_env$AB_lookup[, property, drop = TRUE])) {
x <- rep(NA_character_, length(x)) x <- rep(NA_character_, length(x))
} else { } else {
x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE] x <- AMR_env$AB_lookup[match(x, AMR_env$AB_lookup$ab), property, drop = TRUE]
} }
} }
} }

38
R/ab_selectors.R
View File

@ -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(AB_lookup[which(eval(call, envir = AB_lookup)), "ab", drop = TRUE], agents <- tryCatch(AMR_env$AB_lookup[which(eval(call, envir = AMR_env$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 <- AB_lookup[which(!is.na(AB_lookup$oral_ddd)), "ab", drop = TRUE] agents_all <- AMR_env$AB_lookup[which(!is.na(AMR_env$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 <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% ab_in_data & !is.na(AMR_env$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 <- AB_lookup[which(!is.na(AB_lookup$iv_ddd)), "ab", drop = TRUE] agents_all <- AMR_env$AB_lookup[which(!is.na(AMR_env$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 <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% ab_in_data & !is.na(AMR_env$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",
@ -544,7 +544,7 @@ ab_select_exec <- function(function_name,
# untreatable drugs # untreatable drugs
if (only_treatable == TRUE) { if (only_treatable == TRUE) {
untreatable <- AB_lookup[which(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 (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_(
@ -571,16 +571,16 @@ 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 <- AB_lookup$ab[which(AB_lookup$group == "Antifungals")] abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antifungals")]
} else if (isTRUE(function_name == "antimycobacterials")) { } else if (isTRUE(function_name == "antimycobacterials")) {
abx <- AB_lookup$ab[which(AB_lookup$group == "Antimycobacterials")] abx <- AMR_env$AB_lookup$ab[which(AMR_env$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 # manually added codes from add_custom_antimicrobials() must also be supported
if (length(AMR_env$custom_ab_codes) > 0) { if (length(AMR_env$custom_ab_codes) > 0) {
custom_ab <- AB_lookup[which(AB_lookup$ab %in% AMR_env$custom_ab_codes), ] custom_ab <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% AMR_env$custom_ab_codes), ]
check_string <- paste0(custom_ab$group, custom_ab$atc_group1, custom_ab$atc_group2) check_string <- paste0(custom_ab$group, custom_ab$atc_group1, custom_ab$atc_group2)
if (function_name == "betalactams") { if (function_name == "betalactams") {
find_group <- "beta-lactams" find_group <- "beta-lactams"
@ -602,7 +602,7 @@ ab_select_exec <- function(function_name,
} else { } else {
# this for the 'manual' ab_class() function # this for the 'manual' ab_class() function
abx <- subset( abx <- subset(
AB_lookup, AMR_env$AB_lookup,
group %like% ab_class_args | group %like% ab_class_args |
atc_group1 %like% ab_class_args | atc_group1 %like% ab_class_args |
atc_group2 %like% ab_class_args atc_group2 %like% ab_class_args
@ -792,7 +792,7 @@ is_all <- function(el1) {
find_ab_group <- function(ab_class_args) { find_ab_group <- function(ab_class_args) {
ab_class_args <- gsub("[^a-zA-Z0-9]", ".*", ab_class_args) ab_class_args <- gsub("[^a-zA-Z0-9]", ".*", ab_class_args)
AB_lookup %pm>% AMR_env$AB_lookup %pm>%
subset(group %like% ab_class_args | subset(group %like% ab_class_args |
atc_group1 %like% ab_class_args | atc_group1 %like% ab_class_args |
atc_group2 %like% ab_class_args) %pm>% atc_group2 %like% ab_class_args) %pm>%
@ -807,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 <- AB_lookup[which((!is.na(AB_lookup$iv_ddd) | !is.na(AB_lookup$oral_ddd)) & drugs <- AMR_env$AB_lookup[which((!is.na(AMR_env$AB_lookup$iv_ddd) | !is.na(AMR_env$AB_lookup$oral_ddd)) &
AB_lookup$name %unlike% " " & AMR_env$AB_lookup$name %unlike% " " &
AB_lookup$group %like% ab_group & AMR_env$AB_lookup$group %like% ab_group &
AB_lookup$ab %unlike% "[0-9]$"), ]$name AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
if (length(drugs) < n) { if (length(drugs) < n) {
# now try it all # now try it all
drugs <- AB_lookup[which((AB_lookup$group %like% ab_group | drugs <- AMR_env$AB_lookup[which((AMR_env$AB_lookup$group %like% ab_group |
AB_lookup$atc_group1 %like% ab_group | AMR_env$AB_lookup$atc_group1 %like% ab_group |
AB_lookup$atc_group2 %like% ab_group) & AMR_env$AB_lookup$atc_group2 %like% ab_group) &
AB_lookup$ab %unlike% "[0-9]$"), ]$name AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
} }
if (length(drugs) == 0) { if (length(drugs) == 0) {
return("??") return("??")

27
R/add_custom_antimicrobials.R
View File

@ -86,18 +86,18 @@
#' #'
#' # even antibiotic selectors work #' # even antibiotic selectors work
#' x <- data.frame(random_column = "test", #' x <- data.frame(random_column = "test",
#' coflu = as.rsi("S"), #' coflu = as.rsi("S"),
#' ampicillin = as.rsi("R")) #' ampicillin = as.rsi("R"))
#' x #' x
#' x[, betalactams()] #' 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)),
"`x` must contain columns \"ab\" and \"name\".") "`x` must contain columns \"ab\" and \"name\".")
stop_if(any(x$ab %in% AB_lookup$ab), stop_if(any(x$ab %in% AMR_env$AB_lookup$ab),
"Antimicrobial code(s) ", vector_and(x$ab[x$ab %in% AB_lookup$ab]), " already exist in the internal `antibiotics` data set.") "Antimicrobial code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antibiotics` data set.")
x <- x[, colnames(AB_lookup)[colnames(AB_lookup) %in% colnames(x)], drop = FALSE] x <- x[, colnames(AMR_env$AB_lookup)[colnames(AMR_env$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)) { if ("atc" %in% colnames(x)) {
@ -108,27 +108,16 @@ add_custom_antimicrobials <- function(x) {
} }
AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab) 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 = TRUE)
if (!is.null(bind_rows)) { AMR_env$AB_lookup <- unique(bind_rows(AMR_env$AB_lookup, x))
new_df <- bind_rows(AB_lookup, x)
} else {
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 the 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
#' @export #' @export
clear_custom_antimicrobials <- function() { clear_custom_antimicrobials <- function() {
assignInNamespace(x = "AB_lookup", AMR_env$AB_lookup <- create_AB_lookup()
value = create_AB_lookup(),
ns = asNamespace("AMR"))
AMR_env$custom_ab_codes <- character(0) AMR_env$custom_ab_codes <- character(0)
message_("Custom antimicrobials cleared.") message_("Custom antimicrobials cleared.")
} }

4
R/eucast_rules.R
View File

@ -435,11 +435,11 @@ eucast_rules <- function(x,
} }
if (any(x$genus == "Staphylococcus", na.rm = TRUE)) { if (any(x$genus == "Staphylococcus", na.rm = TRUE)) {
all_staph <- MO_lookup[which(MO_lookup$genus == "Staphylococcus"), , drop = FALSE] all_staph <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$genus == "Staphylococcus"), , drop = FALSE]
all_staph$CNS_CPS <- suppressWarnings(mo_name(all_staph$mo, Becker = "all", language = NULL, info = FALSE)) all_staph$CNS_CPS <- suppressWarnings(mo_name(all_staph$mo, Becker = "all", language = NULL, info = FALSE))
} }
if (any(x$genus == "Streptococcus", na.rm = TRUE)) { if (any(x$genus == "Streptococcus", na.rm = TRUE)) {
all_strep <- MO_lookup[which(MO_lookup$genus == "Streptococcus"), , drop = FALSE] all_strep <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$genus == "Streptococcus"), , drop = FALSE]
all_strep$Lancefield <- suppressWarnings(mo_name(all_strep$mo, Lancefield = TRUE, language = NULL, info = FALSE)) all_strep$Lancefield <- suppressWarnings(mo_name(all_strep$mo, Lancefield = TRUE, language = NULL, info = FALSE))
} }

4
R/guess_ab_col.R
View File

@ -173,7 +173,7 @@ get_column_abx <- function(x,
# only check columns that are a valid AB code, ATC code, name, abbreviation or synonym, # only check columns that are a valid AB code, ATC code, name, abbreviation or synonym,
# or already have the <rsi> class (as.rsi) # or already have the <rsi> class (as.rsi)
# and that they have no more than 50% invalid values # and that they have no more than 50% invalid values
vectr_antibiotics <- unlist(AB_lookup$generalised_all) vectr_antibiotics <- unlist(AMR_env$AB_lookup$generalised_all)
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3] vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
x_columns <- vapply( x_columns <- vapply(
FUN.VALUE = character(1), FUN.VALUE = character(1),
@ -335,7 +335,7 @@ get_ab_from_namespace <- function(x, cols_ab) {
if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) { if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
# antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `AB_CARBAPENEMS` # antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `AB_CARBAPENEMS`
val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR")) val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR"))
} else if (val %in% AB_lookup$ab) { } else if (val %in% AMR_env$AB_lookup$ab) {
# separate drugs, such as `AMX` # separate drugs, such as `AMX`
val <- as.ab(val) val <- as.ab(val)
} else { } else {

6
R/italicise_taxonomy.R
View File

@ -71,7 +71,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
search_strings <- gsub("[^a-zA-Z-]", "", s_split) search_strings <- gsub("[^a-zA-Z-]", "", s_split)
ind_species <- search_strings != "" & ind_species <- search_strings != "" &
search_strings %in% MO_lookup[which(MO_lookup$rank %in% c( search_strings %in% AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
"family", "family",
"genus", "genus",
"species", "species",
@ -85,7 +85,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
ind_fullname <- search_strings != "" & ind_fullname <- search_strings != "" &
search_strings %in% c( search_strings %in% c(
MO_lookup[which(MO_lookup$rank %in% c( AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
"family", "family",
"genus", "genus",
"species", "species",
@ -96,7 +96,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
"fullname", "fullname",
drop = TRUE drop = TRUE
], ],
MO_lookup[which(MO_lookup$rank %in% c( AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
"family", "family",
"genus", "genus",
"species", "species",

2
R/join_microorganisms.R
View File

@ -145,7 +145,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
} }
message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions
} }
if (!all(x[, by, drop = TRUE] %in% MO_lookup$mo, na.rm = TRUE)) { if (!all(x[, by, drop = TRUE] %in% AMR_env$MO_lookup$mo, na.rm = TRUE)) {
x$join.mo <- as.mo(x[, by, drop = TRUE]) x$join.mo <- as.mo(x[, by, drop = TRUE])
by <- c("join.mo" = "mo") by <- c("join.mo" = "mo")
} else { } else {

2
R/mdro.R
View File

@ -326,7 +326,7 @@ mdro <- function(x = NULL,
"No column found as input for `col_mo`, ", "No column found as input for `col_mo`, ",
font_bold(paste0("assuming all rows contain ", font_italic("Mycobacterium tuberculosis"), ".")) font_bold(paste0("assuming all rows contain ", font_italic("Mycobacterium tuberculosis"), "."))
) )
x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: MO_lookup[which(MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE] x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: AMR_env$MO_lookup[which(AMR_env$MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE]
col_mo <- "mo" col_mo <- "mo"
} }
stop_if(is.null(col_mo), "`col_mo` must be set") stop_if(is.null(col_mo), "`col_mo` must be set")

32
R/mo.R
View File

@ -163,7 +163,7 @@ as.mo <- function(x,
language <- validate_language(language) language <- validate_language(language)
meet_criteria(info, allow_class = "logical", has_length = 1) meet_criteria(info, allow_class = "logical", has_length = 1)
if (tryCatch(all(x %in% c(MO_lookup$mo, NA)) && if (tryCatch(all(x %in% c(AMR_env$MO_lookup$mo, NA)) &&
isFALSE(Becker) && isFALSE(Becker) &&
isFALSE(Lancefield), error = function(e) FALSE)) { isFALSE(Lancefield), error = function(e) FALSE)) {
# don't look into valid MO codes, just return them # don't look into valid MO codes, just return them
@ -194,9 +194,9 @@ as.mo <- function(x,
out[x %in% reference_df[[1]]] <- reference_df[[2]][match(x[x %in% reference_df[[1]]], reference_df[[1]])] out[x %in% reference_df[[1]]] <- reference_df[[2]][match(x[x %in% reference_df[[1]]], reference_df[[1]])]
} }
# From MO code ---- # From MO code ----
out[is.na(out) & x %in% MO_lookup$mo] <- x[is.na(out) & x %in% MO_lookup$mo] out[is.na(out) & x %in% AMR_env$MO_lookup$mo] <- x[is.na(out) & x %in% AMR_env$MO_lookup$mo]
# From full name ---- # From full name ----
out[is.na(out) & x_lower %in% MO_lookup$fullname_lower] <- MO_lookup$mo[match(x_lower[is.na(out) & x_lower %in% MO_lookup$fullname_lower], MO_lookup$fullname_lower)] out[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower] <- AMR_env$MO_lookup$mo[match(x_lower[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower], AMR_env$MO_lookup$fullname_lower)]
# one exception: "Fungi" matches the kingdom, but instead it should return the 'unknown' code for fungi # one exception: "Fungi" matches the kingdom, but instead it should return the 'unknown' code for fungi
out[out == "F_[KNG]_FUNGI"] <- "F_FUNGUS" out[out == "F_[KNG]_FUNGI"] <- "F_FUNGUS"
# From known codes ---- # From known codes ----
@ -204,7 +204,7 @@ as.mo <- function(x,
# From SNOMED ---- # From SNOMED ----
if (any(is.na(out) & !is.na(x)) && any(is.na(out) & x %in% unlist(microorganisms$snomed), na.rm = TRUE)) { if (any(is.na(out) & !is.na(x)) && any(is.na(out) & x %in% unlist(microorganisms$snomed), na.rm = TRUE)) {
# found this extremely fast gem here: https://stackoverflow.com/a/11002456/4575331 # found this extremely fast gem here: https://stackoverflow.com/a/11002456/4575331
out[is.na(out) & x %in% unlist(microorganisms$snomed)] <- microorganisms$mo[rep(seq_along(microorganisms$snomed), vapply(FUN.VALUE = double(1), microorganisms$snomed, length))[match(x[is.na(out) & x %in% unlist(microorganisms$snomed)], unlist(microorganisms$snomed))]] out[is.na(out) & x %in% unlist(AMR::microorganisms$snomed)] <- AMR::microorganisms$mo[rep(seq_along(AMR::microorganisms$snomed), vapply(FUN.VALUE = double(1), AMR::microorganisms$snomed, length))[match(x[is.na(out) & x %in% unlist(AMR::microorganisms$snomed)], unlist(AMR::microorganisms$snomed))]]
} }
# From other familiar output ---- # From other familiar output ----
# such as Salmonella groups, colloquial names, etc. # such as Salmonella groups, colloquial names, etc.
@ -261,16 +261,16 @@ as.mo <- function(x,
# do a pre-match on first character (and if it contains a space, first chars of first two terms) # do a pre-match on first character (and if it contains a space, first chars of first two terms)
if (length(x_parts) %in% c(2, 3)) { if (length(x_parts) %in% c(2, 3)) {
# for genus + species + subspecies # for genus + species + subspecies
filtr <- which(MO_lookup$full_first == substr(x_parts[1], 1, 1) & MO_lookup$species_first == substr(x_parts[2], 1, 1)) filtr <- which(AMR_env$MO_lookup$full_first == substr(x_parts[1], 1, 1) & AMR_env$MO_lookup$species_first == substr(x_parts[2], 1, 1))
} else if (length(x_parts) > 3) { } else if (length(x_parts) > 3) {
first_chars <- paste0("(^| )", "[", paste(substr(x_parts, 1, 1), collapse = ""), "]") first_chars <- paste0("(^| )", "[", paste(substr(x_parts, 1, 1), collapse = ""), "]")
filtr <- which(MO_lookup$full_first %like_case% first_chars) filtr <- which(AMR_env$MO_lookup$full_first %like_case% first_chars)
} else if (nchar(x_out) == 4) { } else if (nchar(x_out) == 4) {
# no space and 4 characters - probably a code such as STAU or ESCO! # no space and 4 characters - probably a code such as STAU or ESCO!
if (isTRUE(info)) { if (isTRUE(info)) {
message_("Input \"", x_search, "\" is assumed to be a microorganism code - trying to match on ", vector_and(c(substr(x_out, 1, 2), substr(x_out, 3, 4)), sort = FALSE)) message_("Input \"", x_search, "\" is assumed to be a microorganism code - trying to match on ", vector_and(c(substr(x_out, 1, 2), substr(x_out, 3, 4)), sort = FALSE))
} }
filtr <- which(MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 2), ".* ", substr(x_out, 3, 4))) filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 2), ".* ", substr(x_out, 3, 4)))
} else if (nchar(x_out) <= 6) { } else if (nchar(x_out) <= 6) {
# no space and 5-6 characters - probably a code such as STAAUR or ESCCOL! # no space and 5-6 characters - probably a code such as STAAUR or ESCCOL!
first_part <- paste0(substr(x_out, 1, 2), "[a-z]*", substr(x_out, 3, 3)) first_part <- paste0(substr(x_out, 1, 2), "[a-z]*", substr(x_out, 3, 3))
@ -278,14 +278,14 @@ as.mo <- function(x,
if (isTRUE(info)) { if (isTRUE(info)) {
message_("Input \"", x_search, "\" is assumed to be a microorganism code - trying to match on ", vector_and(c(gsub("[a-z]*", "(...)", first_part, fixed = TRUE), second_part), sort = FALSE)) message_("Input \"", x_search, "\" is assumed to be a microorganism code - trying to match on ", vector_and(c(gsub("[a-z]*", "(...)", first_part, fixed = TRUE), second_part), sort = FALSE))
} }
filtr <- which(MO_lookup$fullname_lower %like_case% paste0("(^| )", first_part, ".* ", second_part)) filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", first_part, ".* ", second_part))
} else { } else {
filtr <- which(MO_lookup$full_first == substr(x_out, 1, 1)) filtr <- which(AMR_env$MO_lookup$full_first == substr(x_out, 1, 1))
} }
if (length(filtr) == 0) { if (length(filtr) == 0) {
mo_to_search <- MO_lookup$fullname mo_to_search <- AMR_env$MO_lookup$fullname
} else { } else {
mo_to_search <- MO_lookup$fullname[filtr] mo_to_search <- AMR_env$MO_lookup$fullname[filtr]
} }
AMR_env$mo_to_search <- mo_to_search AMR_env$mo_to_search <- mo_to_search
# determine the matching score on the original search value # determine the matching score on the original search value
@ -293,9 +293,9 @@ as.mo <- function(x,
if (is.null(minimum_matching_score)) { if (is.null(minimum_matching_score)) {
minimum_matching_score_current <- min(0.6, min(10, nchar(x_search_cleaned)) * 0.08) minimum_matching_score_current <- min(0.6, min(10, nchar(x_search_cleaned)) * 0.08)
# correct back for prevalence # correct back for prevalence
minimum_matching_score_current <- minimum_matching_score_current / MO_lookup$prevalence[match(mo_to_search, MO_lookup$fullname)] minimum_matching_score_current <- minimum_matching_score_current / AMR_env$MO_lookup$prevalence[match(mo_to_search, AMR_env$MO_lookup$fullname)]
# correct back for kingdom # correct back for kingdom
minimum_matching_score_current <- minimum_matching_score_current / MO_lookup$kingdom_index[match(mo_to_search, MO_lookup$fullname)] minimum_matching_score_current <- minimum_matching_score_current / AMR_env$MO_lookup$kingdom_index[match(mo_to_search, AMR_env$MO_lookup$fullname)]
} else { } else {
minimum_matching_score_current <- minimum_matching_score minimum_matching_score_current <- minimum_matching_score
} }
@ -306,7 +306,7 @@ as.mo <- function(x,
warning_("No hits found for \"", x_search, "\" with minimum_matching_score = ", ifelse(is.null(minimum_matching_score), paste0("NULL (=", round(min(minimum_matching_score_current, na.rm = TRUE), 3), ")"), minimum_matching_score), ". Try setting this value lower or even to 0.") warning_("No hits found for \"", x_search, "\" with minimum_matching_score = ", ifelse(is.null(minimum_matching_score), paste0("NULL (=", round(min(minimum_matching_score_current, na.rm = TRUE), 3), ")"), minimum_matching_score), ". Try setting this value lower or even to 0.")
result_mo <- NA_character_ result_mo <- NA_character_
} else { } else {
result_mo <- MO_lookup$mo[match(top_hits[1], MO_lookup$fullname)] result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)]
AMR_env$mo_uncertainties <- rbind(AMR_env$mo_uncertainties, AMR_env$mo_uncertainties <- rbind(AMR_env$mo_uncertainties,
data.frame( data.frame(
original_input = x_search, original_input = x_search,
@ -997,8 +997,8 @@ replace_old_mo_codes <- function(x, property) {
name <- tolower(paste0(name, ".*", collapse = "")) name <- tolower(paste0(name, ".*", collapse = ""))
name <- gsub(" .*", " ", name, fixed = TRUE) name <- gsub(" .*", " ", name, fixed = TRUE)
name <- paste0("^", name) name <- paste0("^", name)
results <- MO_lookup$mo[MO_lookup$kingdom %like_case% kingdom & results <- AMR_env$MO_lookup$mo[AMR_env$MO_lookup$kingdom %like_case% kingdom &
MO_lookup$fullname_lower %like_case% name] AMR_env$MO_lookup$fullname_lower %like_case% name]
if (length(results) > 1) { if (length(results) > 1) {
all_direct_matches <<- FALSE all_direct_matches <<- FALSE
} }

4
R/mo_matching_score.R
View File

@ -109,9 +109,9 @@ mo_matching_score <- function(x, n) {
l_n.lev[lev == l_n] <- lev[lev == l_n] l_n.lev[lev == l_n] <- lev[lev == l_n]
# human pathogenic prevalence (1 to 3), see ?as.mo # human pathogenic prevalence (1 to 3), see ?as.mo
p_n <- MO_lookup[match(n, MO_lookup$fullname), "prevalence", drop = TRUE] p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE]
# kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5) # kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)
k_n <- MO_lookup[match(n, MO_lookup$fullname), "kingdom_index", drop = TRUE] k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE]
# matching score: # matching score:
(l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n) (l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)

4
R/zzz.R
View File

@ -147,8 +147,8 @@ if (utf8_supported && !is_latex) {
# reference data - they have additional columns compared to `antibiotics` and `microorganisms` to improve speed # reference data - they have additional columns compared to `antibiotics` and `microorganisms` to improve speed
# they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB) # they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB)
assign(x = "AB_lookup", value = create_AB_lookup(), envir = asNamespace("AMR")) AMR_env$AB_lookup <- create_AB_lookup()
assign(x = "MO_lookup", value = create_MO_lookup(), envir = asNamespace("AMR")) AMR_env$MO_lookup <- create_MO_lookup()
# for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector # for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
assign(x = "INTRINSIC_R", value = create_intr_resistance(), envir = asNamespace("AMR")) assign(x = "INTRINSIC_R", value = create_intr_resistance(), envir = asNamespace("AMR"))
} }

44
data-raw/_pre_commit_hook.R
View File

@ -145,22 +145,22 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
} }
} }
create_MO_fullname_lower <- function() { create_MO_fullname_lower <- function() {
MO_lookup <- AMR::microorganisms AMR_env$MO_lookup <- AMR::microorganisms
# use this paste instead of `fullname` to work with Viridans Group Streptococci, etc. # use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
MO_lookup$fullname_lower <- tolower(trimws(paste( AMR_env$MO_lookup$fullname_lower <- tolower(trimws(paste(
MO_lookup$genus, AMR_env$MO_lookup$genus,
MO_lookup$species, AMR_env$MO_lookup$species,
MO_lookup$subspecies AMR_env$MO_lookup$subspecies
))) )))
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname, perl = TRUE) ind <- AMR_env$MO_lookup$genus == "" | grepl("^[(]unknown ", AMR_env$MO_lookup$fullname, perl = TRUE)
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname", drop = TRUE]) AMR_env$MO_lookup[ind, "fullname_lower"] <- tolower(AMR_env$MO_lookup[ind, "fullname", drop = TRUE])
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE)) AMR_env$MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", AMR_env$MO_lookup$fullname_lower, perl = TRUE))
MO_lookup$fullname_lower AMR_env$MO_lookup$fullname_lower
} }
MO_CONS <- create_species_cons_cops("CoNS") MO_CONS <- create_species_cons_cops("CoNS")
MO_COPS <- create_species_cons_cops("CoPS") MO_COPS <- create_species_cons_cops("CoPS")
MO_STREP_ABCG <- MO_lookup$mo[which(MO_lookup$genus == "Streptococcus" & MO_STREP_ABCG <- AMR_env$MO_lookup$mo[which(AMR_env$MO_lookup$genus == "Streptococcus" &
MO_lookup$species %in% c( AMR_env$MO_lookup$species %in% c(
"pyogenes", "agalactiae", "dysgalactiae", "equi", "anginosus", "sanguinis", "salivarius", "pyogenes", "agalactiae", "dysgalactiae", "equi", "anginosus", "sanguinis", "salivarius",
"group A", "group B", "group C", "group D", "group F", "group G", "group H", "group K", "group L" "group A", "group B", "group C", "group D", "group F", "group G", "group H", "group K", "group L"
))] ))]
@ -198,10 +198,10 @@ AB_AMINOGLYCOSIDES <- antibiotics %>%
filter(group %like% "aminoglycoside") %>% filter(group %like% "aminoglycoside") %>%
pull(ab) pull(ab)
AB_AMINOPENICILLINS <- as.ab(c("AMP", "AMX")) AB_AMINOPENICILLINS <- as.ab(c("AMP", "AMX"))
AB_ANTIFUNGALS <- AB_lookup %>% AB_ANTIFUNGALS <- AMR_env$AB_lookup %>%
filter(group %like% "antifungal") %>% filter(group %like% "antifungal") %>%
pull(ab) pull(ab)
AB_ANTIMYCOBACTERIALS <- AB_lookup %>% AB_ANTIMYCOBACTERIALS <- AMR_env$AB_lookup %>%
filter(group %like% "antimycobacterial") %>% filter(group %like% "antimycobacterial") %>%
pull(ab) pull(ab)
AB_CARBAPENEMS <- antibiotics %>% AB_CARBAPENEMS <- antibiotics %>%
@ -268,16 +268,16 @@ AB_BETALACTAMS <- c(AB_PENICILLINS, AB_CEPHALOSPORINS, AB_CARBAPENEMS)
DEFINED_AB_GROUPS <- ls(envir = globalenv()) DEFINED_AB_GROUPS <- ls(envir = globalenv())
DEFINED_AB_GROUPS <- DEFINED_AB_GROUPS[!DEFINED_AB_GROUPS %in% globalenv_before_ab] DEFINED_AB_GROUPS <- DEFINED_AB_GROUPS[!DEFINED_AB_GROUPS %in% globalenv_before_ab]
create_AB_lookup <- function() { create_AB_lookup <- function() {
AB_lookup <- AMR::antibiotics AMR_env$AB_lookup <- AMR::antibiotics
AB_lookup$generalised_name <- generalise_antibiotic_name(AB_lookup$name) AMR_env$AB_lookup$generalised_name <- generalise_antibiotic_name(AMR_env$AB_lookup$name)
AB_lookup$generalised_synonyms <- lapply(AB_lookup$synonyms, generalise_antibiotic_name) AMR_env$AB_lookup$generalised_synonyms <- lapply(AMR_env$AB_lookup$synonyms, generalise_antibiotic_name)
AB_lookup$generalised_abbreviations <- lapply(AB_lookup$abbreviations, generalise_antibiotic_name) AMR_env$AB_lookup$generalised_abbreviations <- lapply(AMR_env$AB_lookup$abbreviations, generalise_antibiotic_name)
AB_lookup$generalised_loinc <- lapply(AB_lookup$loinc, generalise_antibiotic_name) AMR_env$AB_lookup$generalised_loinc <- lapply(AMR_env$AB_lookup$loinc, generalise_antibiotic_name)
AB_lookup$generalised_all <- unname(lapply( AMR_env$AB_lookup$generalised_all <- unname(lapply(
as.list(as.data.frame(t(AB_lookup[, as.list(as.data.frame(t(AMR_env$AB_lookup[,
c( c(
"ab", "atc", "cid", "name", "ab", "atc", "cid", "name",
colnames(AB_lookup)[colnames(AB_lookup) %like% "generalised"] colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %like% "generalised"]
), ),
drop = FALSE drop = FALSE
]), ]),
@ -288,7 +288,7 @@ create_AB_lookup <- function() {
x[x != ""] x[x != ""]
} }
)) ))
AB_lookup[, colnames(AB_lookup)[colnames(AB_lookup) %like% "^generalised"]] AMR_env$AB_lookup[, colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %like% "^generalised"]]
} }
AB_LOOKUP <- create_AB_lookup() AB_LOOKUP <- create_AB_lookup()

2
inst/tinytest/test-data.R
View File

@ -64,7 +64,7 @@ if (AMR:::pkg_is_available("tibble", also_load = FALSE)) {
} }
} }
df <- AMR:::MO_lookup df <- AMR:::AMR_env$MO_lookup
expect_true(nrow(df[which(df$prevalence == 1), , drop = FALSE]) < nrow(df[which(df$prevalence == 2), , drop = FALSE])) expect_true(nrow(df[which(df$prevalence == 1), , drop = FALSE]) < nrow(df[which(df$prevalence == 2), , drop = FALSE]))
expect_true(nrow(df[which(df$prevalence == 2), , drop = FALSE]) < nrow(df[which(df$prevalence == 3), , drop = FALSE])) expect_true(nrow(df[which(df$prevalence == 2), , drop = FALSE]) < nrow(df[which(df$prevalence == 3), , drop = FALSE]))
expect_true(all(c( expect_true(all(c(

4
man/add_custom_antimicrobials.Rd
View File

@ -69,8 +69,8 @@ ab_name("J01CR50")
# even antibiotic selectors work # even antibiotic selectors work
x <- data.frame(random_column = "test", x <- data.frame(random_column = "test",
coflu = as.rsi("S"), coflu = as.rsi("S"),
ampicillin = as.rsi("R")) ampicillin = as.rsi("R"))
x x
x[, betalactams()] x[, betalactams()]
} }