diff --git a/DESCRIPTION b/DESCRIPTION index 7d8051b0e..eedc0aed6 100644 --- a/DESCRIPTION +++ b/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", , "patilindrajeet.science@gmail.com", role = "aut", comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")), diff --git a/R/data_reverse.R b/R/data_reverse.R index b9615417e..6e1ef414b 100644 --- a/R/data_reverse.R +++ b/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 } diff --git a/R/to_numeric.R b/R/to_numeric.R index 9a35f9130..602891f70 100644 --- a/R/to_numeric.R +++ b/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 diff --git a/R/utils_labels.R b/R/utils_labels.R index a783e4fda..5bcebc80d 100644 --- a/R/utils_labels.R +++ b/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 } diff --git a/tests/testthat/test-data_to_numeric.R b/tests/testthat/test-data_to_numeric.R index 3e0a9d095..a170be60e 100644 --- a/tests/testthat/test-data_to_numeric.R +++ b/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") + ) +})