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

(v1.5.0.9030) as.ab() speed improvement

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-03-05 10:32:09 +01:00
parent 0e0e3c4ffa
commit 0d29bde693
29 changed files with 133 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
R/ab.R
View File

@ -105,14 +105,29 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
already_regex <- isTRUE(list(...)$already_regex)
fast_mode <- isTRUE(list(...)$fast_mode)
if (all(toupper(x) %in% antibiotics$ab)) {
# valid AB code, but not yet right class
return(set_clean_class(toupper(x),
new_class = c("ab", "character")))
}
x_bak <- x
x <- toupper(x)
x_nonNA <- x[!is.na(x)]
if (all(x_nonNA %in% antibiotics$ab, na.rm = TRUE)) {
# all valid AB codes, but not yet right class
return(set_clean_class(x,
new_class = c("ab", "character")))
}
if (all(x_nonNA %in% toupper(antibiotics$name), na.rm = TRUE)) {
# all valid AB names
out <- antibiotics$ab[match(x, toupper(antibiotics$name))]
out[is.na(x)] <- NA_character_
return(out)
}
if (all(x_nonNA %in% antibiotics$atc, na.rm = TRUE)) {
# all valid ATC codes
out <- antibiotics$ab[match(x, antibiotics$atc)]
out[is.na(x)] <- NA_character_
return(out)
}
# remove diacritics
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
x <- gsub('"', "", x, fixed = TRUE)