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

(v1.7.1.9002) ab class selectors update

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-06-14 22:04:04 +02:00
parent 683a0e748a
commit 99be4c7e7e
36 changed files with 416 additions and 198 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
R/mo.R
View File

@ -1664,16 +1664,25 @@ pillar_shaft.mo <- function(x, ...) {
out[is.na(x)] <- font_na(" NA")
out[x == "UNKNOWN"] <- font_na(" UNKNOWN")
if (!all(x[!is.na(x)] %in% MO_lookup$mo)) {
df <- tryCatch(get_current_data(arg_name = "x",
call = 0,
reuse_from_1st_call = FALSE),
error = function(e) NULL)
if (!is.null(df)) {
mo_cols <- vapply(FUN.VALUE = logical(1), df, is.mo)
} else {
mo_cols <- NULL
}
if (!all(x[!is.na(x)] %in% MO_lookup$mo) |
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% MO_lookup$mo))) {
# markup old mo codes
out[!x %in% MO_lookup$mo] <- font_italic(font_na(x[!x %in% MO_lookup$mo],
collapse = NULL),
collapse = NULL)
# throw a warning with the affected column name
mo <- tryCatch(search_type_in_df(get_current_data(arg_name = "x", call = 0), type = "mo", info = FALSE),
error = function(e) NULL)
if (!is.null(mo)) {
col <- paste0("Column '", mo, "'")
# throw a warning with the affected column name(s)
if (!is.null(mo_cols)) {
col <- paste0("Column ", vector_or(colnames(df)[mo_cols], quotes = TRUE, sort = FALSE))
} else {
col <- "The data"
}
@ -1681,7 +1690,7 @@ pillar_shaft.mo <- function(x, ...) {
"Please update your MO codes with `as.mo()`.",
call = FALSE)
}
# make it always fit exactly
max_char <- max(nchar(x))
if (is.na(max_char)) {
@ -2039,12 +2048,16 @@ parse_and_convert <- function(x) {
x <- as.data.frame(x, stringsAsFactors = FALSE)[[1]]
}
}
x_class <- class(x)
x <- as.character(x)
x[is.null(x)] <- NA
parsed <- iconv(x, to = "UTF-8")
parsed[is.na(parsed) & !is.na(x)] <- iconv(x[is.na(parsed) & !is.na(x)], from = "Latin1", to = "ASCII//TRANSLIT")
parsed <- gsub('"', "", parsed, fixed = TRUE)
parsed <- gsub(" +", " ", parsed, perl = TRUE)
parsed <- trimws(parsed)
class(parsed) <- x_class
parsed
}, error = function(e) stop(e$message, call. = FALSE)) # this will also be thrown when running `as.mo(no_existing_object)`
parsed
}