From 47fb3fcecaea7104a13d98fc40bdc20f0c4bfa68 Mon Sep 17 00:00:00 2001
From: Andreas Gammelgaard Damsbo <andreas@gdamsbo.dk>
Date: Wed, 20 Nov 2024 15:23:31 +0100
Subject: [PATCH] small adjustments to interpret character vectors of roman
 numerals as numeric vector

---
 R/as_factor.R | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

diff --git a/R/as_factor.R b/R/as_factor.R
index dcfe0bc..982deb3 100644
--- a/R/as_factor.R
+++ b/R/as_factor.R
@@ -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)
 }