support haven_labelled-class (#468)

* support haven_labelled * fix * fix
easystats · Nov 19, 2023 · 5d92576 · 5d92576
1 parent b65df4d
commit 5d92576
Show file tree

Hide file tree

Showing 7 changed files with 56 additions and 1 deletion.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: datawizard
 Title: Easy Data Wrangling and Statistical Transformations
-Version: 0.9.0.2
+Version: 0.9.0.3
 Authors@R: c(
     person("Indrajeet", "Patil", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")),

diff --git a/NAMESPACE b/NAMESPACE
@@ -167,7 +167,9 @@ S3method(to_factor,Date)
 S3method(to_factor,character)
 S3method(to_factor,data.frame)
 S3method(to_factor,default)
+S3method(to_factor,double)
 S3method(to_factor,factor)
+S3method(to_factor,haven_labelled)
 S3method(to_factor,logical)
 S3method(to_factor,numeric)
 S3method(to_numeric,Date)
@@ -179,6 +181,7 @@ S3method(to_numeric,data.frame)
 S3method(to_numeric,default)
 S3method(to_numeric,double)
 S3method(to_numeric,factor)
+S3method(to_numeric,haven_labelled)
 S3method(to_numeric,logical)
 S3method(to_numeric,numeric)
 S3method(unnormalize,data.frame)

diff --git a/NEWS.md b/NEWS.md
@@ -5,6 +5,8 @@ CHANGES
 * `rescale()` gains `multiply` and `add` arguments, to expand ranges by a given
   factor or value.
 
+* `to_factor()` and `to_numeric()` now support class `haven_labelled`.
+
 # datawizard 0.9.0
 
 NEW FUNCTIONS

diff --git a/R/to_factor.R b/R/to_factor.R
@@ -79,6 +79,12 @@ to_factor.character <- to_factor.numeric
 #' @export
 to_factor.Date <- to_factor.numeric
 
+#' @export
+to_factor.haven_labelled <- to_factor.numeric
+
+#' @export
+to_factor.double <- to_factor.numeric
+
 #' @rdname to_factor
 #' @export
 to_factor.data.frame <- function(x,

diff --git a/R/to_numeric.R b/R/to_numeric.R
@@ -157,6 +157,9 @@ to_numeric.double <- to_numeric.numeric
 #' @export
 to_numeric.logical <- to_numeric.numeric
 
+#' @export
+to_numeric.haven_labelled <- to_numeric.numeric
+
 #' @export
 to_numeric.Date <- function(x, verbose = TRUE, ...) {
   if (verbose) {

diff --git a/tests/testthat/test-data_to_factor.R b/tests/testthat/test-data_to_factor.R
@@ -141,3 +141,24 @@ test_that("data_read, convert many labels correctly", {
   expect_snapshot(data_tabulate(to_factor(d$c12c)))
   unlink(temp_file)
 })
+
+
+test_that("to_factor works with haven_labelled, convert many labels correctly", {
+  skip_if_not_installed("withr")
+  withr::with_tempfile("temp_file", fileext = ".sav", code = {
+    request <- httr::GET("https://raw.github.com/easystats/circus/main/data/EFC.sav")
+    httr::stop_for_status(request)
+    writeBin(httr::content(request, type = "raw"), temp_file)
+
+    d <- haven::read_spss(temp_file)
+    x <- to_factor(d$c172code)
+    expect_identical(
+      levels(x),
+      c(
+        "low level of education",
+        "intermediate level of education",
+        "high level of education"
+      )
+    )
+  })
+})
diff --git a/tests/testthat/test-data_to_numeric.R b/tests/testthat/test-data_to_numeric.R
@@ -160,3 +160,23 @@ test_that("to_numeric regex", {
     to_numeric(mtcars, select = "mpg")
   )
 })
+
+
+test_that("to_numeric works with haven_labelled, convert many labels correctly", {
+  skip_on_cran()
+  skip_if_not_installed("httr")
+  skip_if_not_installed("haven")
+  skip_if_not_installed("withr")
+  skip_if_not_installed("curl")
+  skip_if_offline()
+
+  withr::with_tempfile("temp_file", fileext = ".sav", code = {
+    request <- httr::GET("https://raw.github.com/easystats/circus/main/data/EFC.sav")
+    httr::stop_for_status(request)
+    writeBin(httr::content(request, type = "raw"), temp_file)
+
+    d <- haven::read_spss(temp_file)
+    x <- to_numeric(d$c172code)
+    expect_identical(as.vector(table(x)), c(180L, 506L, 156L))
+  })
+})