resolves #39

jmbarbone · Aug 23, 2021 · b96f7f5 · b96f7f5
1 parent 935ecd5
commit b96f7f5
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 4 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -3,6 +3,7 @@
 * adds `unlist0()` to retain original names of lists
 * adds `%names%` for a fun way to set names
 * adds `file_open()` as alias for `open_file()`
+* `fact.haven_labelled()` now returns an object with class `fact` [#39](https://github.com/jmbarbone/mark/issues/39); performance enhacements
 
 # mark 0.2.0
 

diff --git a/R/fact.R b/R/fact.R
@@ -144,7 +144,8 @@ fact.pseudo_id <- function(x) {
 fact.haven_labelled <- function(x) {
   require_namespace("haven")
   labels <- sort(attr(x, "labels", exact = TRUE))
-  u <- unique(unclass(x))
+  uc <- unclass(x)
+  u <- unique(uc)
   m <- match(u, labels)
   nas <- is.na(m)
 
@@ -153,11 +154,14 @@ fact.haven_labelled <- function(x) {
     labels <- labels[m]
     labels[nas] <- u[nas]
     names(labels)[nas] <- u[nas]
+    mx <- match(x, labels)
+  } else {
+    mx <- as.integer(x)
   }
 
   struct(
-    match(x, labels),
-    class = "factor",
+    mx,
+    class = c("fact", "factor"),
     levels = names(labels),
     label = attr(x, "label", exact = TRUE)
   )

diff --git a/tests/testthat/test-fact.R b/tests/testthat/test-fact.R
@@ -66,7 +66,8 @@ test_that("fact.factor() works", {
 
 test_that("fact.haven_labelled() works", {
   skip_if_not_installed("haven")
-  haven_as_factor <- "haven" %colons% "as_factor.haven_labelled"
+  .haven_as_factor <- "haven" %colons% "as_factor.haven_labelled"
+  haven_as_factor <- function(...) add_class(.haven_as_factor(...), "fact", 1L)
 
   # Integers
   r <- rep(1:3, 2)