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

(v1.7.0.9000) package size

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-05-30 22:14:38 +02:00
parent f1d9b489c5
commit f406319503
43 changed files with 305 additions and 283 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
R/aa_helper_functions.R
View File

@ -178,9 +178,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
found <- sort(colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)])[1]
} else if ("mo" %in% colnames(x) &
suppressWarnings(
all(x$mo %in% c(NA,
microorganisms$mo,
microorganisms.translation$mo_old)))) {
all(x$mo %in% c(NA, microorganisms$mo)))) {
found <- "mo"
} else if (any(colnames(x) %like% "^(mo|microorganism|organism|bacteria|ba[ck]terie)s?$")) {
found <- sort(colnames(x)[colnames(x) %like% "^(mo|microorganism|organism|bacteria|ba[ck]terie)s?$"])[1]

4
R/first_isolate.R
View File

@ -472,8 +472,8 @@ first_isolate <- function(x = NULL,
as_note = FALSE)
}
if (type == "points") {
message_("Basing inclusion on all antimicrobial results, using a points threshold of "
, points_threshold,
message_("Basing inclusion on all antimicrobial results, using a points threshold of ",
points_threshold,
add_fn = font_black,
as_note = FALSE)
}

4
R/key_antimicrobials.R
View File

@ -140,7 +140,7 @@ key_antimicrobials <- function(x = NULL,
meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# force regular [data.frame], not a tibble or data.table
# force regular data.frame, not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
cols <- get_column_abx(x, info = FALSE, only_rsi_columns = only_rsi_columns)
@ -237,7 +237,7 @@ all_antimicrobials <- function(x = NULL,
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# force regular [data.frame], not a tibble or data.table
# force regular data.frame, not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
cols <- get_column_abx(x, only_rsi_columns = only_rsi_columns, info = FALSE, sort = FALSE)

43
R/mo.R
View File

@ -1817,8 +1817,7 @@ as.data.frame.mo <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(i)
# must only contain valid MOs
return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
return_after_integrity_check(y, "microorganism code", as.character(microorganisms$mo))
}
#' @method [[<- mo
#' @export
@ -1827,8 +1826,7 @@ as.data.frame.mo <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(i)
# must only contain valid MOs
return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
return_after_integrity_check(y, "microorganism code", as.character(microorganisms$mo))
}
#' @method c mo
#' @export
@ -1837,8 +1835,7 @@ c.mo <- function(...) {
x <- list(...)[[1L]]
y <- NextMethod()
attributes(y) <- attributes(x)
return_after_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
as.character(microorganisms.translation$mo_old)))
return_after_integrity_check(y, "microorganism code", as.character(microorganisms$mo))
}
#' @method unique mo
@ -2053,23 +2050,39 @@ parse_and_convert <- function(x) {
}
replace_old_mo_codes <- function(x, property) {
if (any(toupper(x) %in% microorganisms.translation$mo_old, na.rm = TRUE)) {
ind <- x %like% "[A-Z_]" & !x %in% MO_lookup$mo
if (any(ind)) {
# get the ones that match
matched <- match(toupper(x), microorganisms.translation$mo_old)
# and their new codes
mo_new <- microorganisms.translation$mo_new[matched]
affected <- x[ind]
affected_unique <- unique(affected)
all_direct_matches <- TRUE
# find their new codes, once per code
solved_unique <- unlist(lapply(strsplit(affected_unique, ""),
function(m) {
m <- m[3:length(m)]
m <- m[m != "_"]
m <- tolower(paste0(m, ".*", collapse = ""))
out <- MO_lookup$mo[MO_lookup$fullname_lower %like_case% m]
if (length(out) > 1) {
all_direct_matches <<- FALSE
}
out[1L]
}), use.names = FALSE)
solved <- solved_unique[match(affected, affected_unique)]
# assign on places where a match was found
x[which(!is.na(matched))] <- mo_new[which(!is.na(matched))]
n_matched <- length(matched[!is.na(matched)])
x[ind] <- solved
n_matched <- length(affected[!is.na(affected)])
n_unique <- length(affected_unique[!is.na(affected_unique)])
if (property != "mo") {
message_(font_blue(paste0("The input contained ", n_matched,
" old MO code", ifelse(n_matched == 1, "", "s"),
" (from a previous AMR package version). Please update your MO codes with `as.mo()`.")))
" (", n_unique, " unique, from a previous AMR package version). Please update your MO codes with `as.mo()` to increase speed.")))
} else {
message_(font_blue(paste0(n_matched, " old MO code", ifelse(n_matched == 1, "", "s"),
" (from a previous AMR package version) ",
" (", n_unique, " unique, from a previous AMR package version) ",
ifelse(n_matched == 1, "was", "were"),
" updated to ", ifelse(n_matched == 1, "a ", ""),
ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
"to ", ifelse(n_matched == 1, "a ", ""),
"currently used MO code", ifelse(n_matched == 1, "", "s"), ".")))
}
}

4
R/mo_source.R
View File

@ -275,9 +275,9 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
return(FALSE)
}
}
if (!all(x$mo %in% c("", microorganisms$mo, microorganisms.translation$mo_old), na.rm = TRUE)) {
if (!all(x$mo %in% c("", microorganisms$mo), na.rm = TRUE)) {
if (stop_on_error == TRUE) {
invalid <- x[which(!x$mo %in% c("", microorganisms$mo, microorganisms.translation$mo_old)), , drop = FALSE]
invalid <- x[which(!x$mo %in% c("", microorganisms$mo)), , drop = FALSE]
if (nrow(invalid) > 1) {
plural <- "s"
} else {

BIN
R/sysdata.rda
View File

Binary file not shown.

72
R/zzz.R
View File

@ -72,4 +72,76 @@ if (utf8_supported && !is_latex) {
invisible(get_mo_source())
}
}, silent = TRUE)
# reference data - they have additional columns compared to `antibiotics` and `microorganisms` to improve speed
assign(x = "AB_lookup", value = create_AB_lookup(), envir = asNamespace("AMR"))
assign(x = "MO_lookup", value = create_MO_lookup(), envir = asNamespace("AMR"))
assign(x = "MO.old_lookup", value = create_MO.old_lookup(), envir = asNamespace("AMR"))
# 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"))
}
# Helper functions --------------------------------------------------------
create_AB_lookup <- function() {
AB_lookup <- AMR::antibiotics
AB_lookup$generalised_name <- generalise_antibiotic_name(AB_lookup$name)
AB_lookup$generalised_synonyms <- lapply(AB_lookup$synonyms, generalise_antibiotic_name)
AB_lookup$generalised_abbreviations <- lapply(AB_lookup$abbreviations, generalise_antibiotic_name)
AB_lookup$generalised_loinc <- lapply(AB_lookup$loinc, generalise_antibiotic_name)
AB_lookup$generalised_all <- unname(lapply(as.list(as.data.frame(t(AB_lookup[,
c("ab", "atc", "cid", "name",
colnames(AB_lookup)[colnames(AB_lookup) %like% "generalised"]),
drop = FALSE]),
stringsAsFactors = FALSE)),
function(x) {
x <- generalise_antibiotic_name(unname(unlist(x)))
x[x != ""]
}))
AB_lookup
}
create_MO_lookup <- function() {
MO_lookup <- AMR::microorganisms
MO_lookup$kingdom_index <- NA_real_
MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1
MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 2
MO_lookup[which(MO_lookup$kingdom == "Protozoa"), "kingdom_index"] <- 3
MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 4
# all the rest
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
# use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
MO_lookup$fullname_lower <- tolower(trimws(paste(MO_lookup$genus,
MO_lookup$species,
MO_lookup$subspecies)))
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname, perl = TRUE)
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname"])
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
# add a column with only "e coli" like combinations
MO_lookup$g_species <- gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO_lookup$fullname_lower, perl = TRUE)
# so arrange data on prevalence first, then kingdom, then full name
MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower), ]
}
create_MO.old_lookup <- function() {
MO.old_lookup <- AMR::microorganisms.old
MO.old_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", tolower(trimws(MO.old_lookup$fullname))))
# add a column with only "e coli"-like combinations
MO.old_lookup$g_species <- trimws(gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO.old_lookup$fullname_lower))
# so arrange data on prevalence first, then full name
MO.old_lookup[order(MO.old_lookup$prevalence, MO.old_lookup$fullname_lower), ]
}
create_intr_resistance <- function() {
# for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
paste(AMR::microorganisms[match(AMR::intrinsic_resistant$microorganism, AMR::microorganisms$fullname), "mo", drop = TRUE],
AMR::antibiotics[match(AMR::intrinsic_resistant$antibiotic, AMR::antibiotics$name), "ab", drop = TRUE])
}