P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 20:41:58 +02: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
Download Patch File Download Diff File Expand all files Collapse all files

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, ...) {
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>
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 {
# try to catch an error when inputting an invalid argument
# 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)
)
if (!all(x %in% AB_lookup[, property, drop = TRUE])) {
if (!all(x %in% AMR_env$AB_lookup[, property, drop = TRUE])) {
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))
} 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]
}
}
}