1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 06:51:48 +02:00
This commit is contained in:
2022-08-28 21:13:26 +02:00
parent 1e4eaf23f2
commit 2ed5f13880
6 changed files with 25 additions and 14 deletions

15
R/ab.R
View File

@ -125,6 +125,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x <- unique(x_bak_clean) # this means that every x is in fact generalise_antibiotic_name(x)
x_new <- rep(NA_character_, length(x))
x_unknown <- character(0)
x_unknown_ATCs <- character(0)
note_if_more_than_one_found <- function(found, index, from_text) {
if (initial_search == TRUE & isTRUE(length(from_text) > 1)) {
@ -183,6 +184,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
next
}
if (x[i] %like_case% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]") {
# seems an ATC code, but the available ones are in `already_known`, so:
x_unknown <- c(x_unknown, x[i])
x_unknown_ATCs <- c(x_unknown_ATCs, x[i])
x_new[i] <- NA_character_
next
}
if (fast_mode == FALSE && flag_multiple_results == TRUE && x[i] %like% "[ ]") {
from_text <- tryCatch(suppressWarnings(ab_from_text(x[i], initial_search = FALSE, translate_ab = FALSE)[[1]]),
@ -474,16 +482,15 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
}
# take failed ATC codes apart from rest
x_unknown_ATCs <- x_unknown[x_unknown %like% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]"]
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
if (length(x_unknown_ATCs) > 0 & fast_mode == FALSE) {
if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
warning_(
"in `as.ab()`: these ATC codes are not (yet) in the antibiotics data set: ",
vector_and(x_unknown_ATCs), "."
)
}
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
if (length(x_unknown) > 0 & fast_mode == FALSE) {
if (length(x_unknown) > 0 && fast_mode == FALSE) {
warning_(
"in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
vector_and(x_unknown), "."

View File

@ -457,7 +457,11 @@ ab_validate <- function(x, property, ...) {
if (!all(x %in% AB_lookup[, property, drop = TRUE])) {
x <- as.ab(x, ...)
x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE]
if (all(is.na(x)) && is.list(AB_lookup[, property, drop = TRUE])) {
x <- rep(NA_character_, length(x))
} else {
x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE]
}
}
}