Preserve correct label oder

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: datawizard
 Title: Easy Data Wrangling and Statistical Transformations
-Version: 0.9.0.6
+Version: 0.9.0.7
 Authors@R: c(
     person("Indrajeet", "Patil", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")),

R/data_reverse.R

@@ -110,7 +110,7 @@ reverse.numeric <- function(x,
   out <- as.vector((new_max - new_min) / (max - min) * (x - min) + new_min)
 
   # labelled data?
-  out <- .set_back_labels(out, x)
+  out <- .set_back_labels(out, x, reverse_values = TRUE)
   out
 }
 
@@ -189,7 +189,7 @@ reverse.factor <- function(x, range = NULL, verbose = TRUE, ...) {
   x <- factor(rev_x, levels = seq_len(length(old_levels)), labels = old_levels)
 
   # labelled data?
-  x <- .set_back_labels(x, original_x)
+  x <- .set_back_labels(x, original_x, reverse_values = TRUE)
 
   x
 }

R/to_numeric.R

@@ -148,7 +148,7 @@ to_numeric.data.frame <- function(x,
 
 #' @export
 to_numeric.numeric <- function(x, verbose = TRUE, ...) {
-  .set_back_labels(as.numeric(x), x)
+  .set_back_labels(as.numeric(x), x, reverse_values = FALSE)
 }
 
 #' @export
@@ -233,9 +233,9 @@ to_numeric.factor <- function(x,
       }
       x <- factor(x_inverse)
     }
-    out <- .set_back_labels(as.numeric(as.character(x)), x)
+    out <- .set_back_labels(as.numeric(as.character(x)), x, reverse_values = FALSE)
   } else {
-    out <- .set_back_labels(as.numeric(x), x)
+    out <- .set_back_labels(as.numeric(x), x, , reverse_values = FALSE)
   }
 
   # shift to requested starting value

R/utils_labels.R

@@ -3,12 +3,19 @@
 # to the transformed vector
 
 #' @keywords internal
-.set_back_labels <- function(new, old, include_values = TRUE) {
+.set_back_labels <- function(new, old, include_values = TRUE, reverse_values = FALSE) {
   # labelled data?
   attr(new, "label") <- attr(old, "label", exact = TRUE)
   labels <- attr(old, "labels", exact = TRUE)
+  # "include_values" is used to preserve value labels
   if (isTRUE(include_values) && !is.null(labels)) {
-    attr(new, "labels") <- stats::setNames(rev(labels), names(labels))
+    if (reverse_values) {
+      # reverse values? Used for "reverse_scale()"
+      attr(new, "labels") <- stats::setNames(rev(labels), names(labels))
+    } else {
+      # keep value oder? Used for "to_numeric()"
+      attr(new, "labels") <- stats::setNames(labels, names(labels))
+    }
   } else if (isFALSE(include_values)) {
     attr(new, "labels") <- NULL
   }

tests/testthat/test-data_to_numeric.R

@@ -189,3 +189,20 @@ test_that("to_numeric works with haven_labelled, convert many labels correctly",
     expect_identical(as.vector(table(x)), c(180L, 506L, 156L))
   })
 })
+
+
+test_that("to_numeric preserves correct label order", {
+  x <- factor(c(1, 2, 3, 4))
+  x <- assign_labels(x, values = c("one", "two", "three", "four"))
+  out <- to_numeric(x, dummy_factors = FALSE)
+  expect_identical(
+    attributes(out)$labels,
+    c(one = "1", two = "2", three = "3", four = "4")
+  )
+  # correctly reverse scale
+  out <- to_numeric(reverse_scale(x), dummy_factors = FALSE)
+  expect_identical(
+    attributes(out)$labels,
+    c(one = "4", two = "3", three = "2", four = "1")
+  )
+})