andreas/REDCapCAST
1
0
Fork 0
mirror of https://github.com/agdamsbo/REDCapCAST.git synced 2024-11-21 13:00:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

small adjustments to interpret character vectors of roman numerals as numeric vector

Browse Source
This commit is contained in:
Andreas Gammelgaard Damsbo 2024-11-20 15:23:31 +01:00
parent 18544ddcfe
commit 47fb3fceca
No known key found for this signature in database
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
R/as_factor.R
View File

@ -56,10 +56,13 @@ as_factor.numeric <- function(x, ...) {
#' @export
as_factor.character <- function(x, ...) {
labels <- get_attr(x)
if (is.roman(x)){
x <- factor(x)
} else {
x <- structure(
forcats::fct_inorder(x),
label = attr(x, "label", exact = TRUE)
)
)}
set_attr(x, labels, overwrite = FALSE)
}
@ -218,15 +221,16 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99)
out <- stats::setNames(d$value, d$name)
## Sort if levels are numeric
## Else, they appear in order of appearance
if (identical(
levels(data),
suppressWarnings(as.character(as.numeric(levels(data))))
)) {
if (possibly_numeric(levels(data))) {
out <- out |> sort()
}
out
}
is.roman <- function(data){
identical(data,as.character(utils::as.roman(data)))
}
#' Allows conversion of factor to numeric values preserving original levels
#'
@ -277,13 +281,13 @@ fct2num <- function(data) {
## If no NA on numeric coercion, of original names, then return
## original numeric names, else values
if (possible_numeric(out)) {
if (possibly_numeric(out)) {
out <- as.numeric(names(out))
}
unname(out)
}
possible_numeric <- function(data){
possibly_numeric <- function(data){
length(stats::na.omit(suppressWarnings(as.numeric(names(data))))) ==
length(data)
}