preserve subclasses as well as attrs in refactor fn #83

Author: khusmann

R/lvls.R

@@ -95,6 +95,17 @@ refactor <- function(f, new_levels, ordered = NA) {
 
   new_f <- factor(f, levels = new_levels, exclude = NULL, ordered = ordered)
   attributes(new_f) <- utils::modifyList(attributes(f), attributes(new_f))
+
+  if (is.ordered(f) && !is.ordered(new_f)) {
+    idx <- match("ordered", class(f))
+    class(new_f) <- class(f)[-idx]
+  } else if (!is.ordered(f) && is.ordered(new_f)) {
+    idx <- match("factor", class(f))
+    class(new_f) <- append(class(f), "ordered", after = idx - 1)
+  } else {
+    class(new_f) <- class(f)
+  }
+
   new_f
 }
 

tests/testthat/test-lvls.R

@@ -80,3 +80,36 @@ test_that("can change ordered status of output", {
   expect_equal(is.ordered(lvls_reorder(f2, 1:3, ordered = FALSE)), FALSE)
   expect_equal(is.ordered(lvls_reorder(f2, 1:3, ordered = TRUE)), TRUE)
 })
+
+# refactor ------------------------------------------------------------
+
+test_that("preserves attributes", {
+  f1 <- factor(letters[1:3])
+  attr(f1, "foo") <- "bar"
+
+  f2 <- refactor(f1, letters[1:4])
+
+  expect_equal(attr(f1, "foo"), attr(f2, "foo"))
+})
+
+test_that("preserves s3 subclasses", {
+  f1 <- factor(letters[1:3])
+  class(f1) <- c("foo", class(f1))
+
+  f2 <- refactor(f1, letters[1:4])
+
+  expect_equal(class(f1), class(f2))
+})
+
+test_that("preserves s3 subclasses when toggling ordered", {
+  f1 <- factor(letters[1:3])
+  class(f1) <- c("foo", class(f1))
+
+  f2 <- refactor(f1, letters[1:4], ordered = TRUE)
+
+  expect_equal(class(f2), c("foo", "ordered", "factor"))
+
+  f3 <- refactor(f2, letters[1:3], ordered = FALSE)
+
+  expect_equal(class(f3), c("foo", "factor"))
+})