Fix data_write() for partially labelled characters (#459)

* fix data_write for partially labelled characters * remove whitespace * Update tests/testthat/test-data_write.R Co-authored-by: Etienne Bacher <[email protected]> * use correct file path * read back and check --------- Co-authored-by: Etienne Bacher <[email protected]>
easystats · Sep 14, 2023 · 6e93950 · 6e93950
1 parent 2989935
commit 6e93950
Show file tree

Hide file tree

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

diff --git a/NEWS.md b/NEWS.md
@@ -41,6 +41,10 @@ BUG FIXES
 * Fixed issues in `data_write()` when writing labelled data into SPSS format
   and vectors were of different type as value labels.
 
+* Fixed issues in `data_write()` when writing labelled data into SPSS format
+  for character vectors with missing value labels, but existing variable
+  labels.
+
 * Fixed issue in `recode_into()` with probably wrong case number printed in the
   warning when several recode patterns match to one case.
 

diff --git a/R/data_write.R b/R/data_write.R
@@ -142,9 +142,13 @@ data_write <- function(data,
       # character requires special preparation to save value labels
       # haven:::vec_cast_named requires "x" and "labels" to be of same type
       if (is.character(i)) {
+        # only prepare value labels when these are not NULL
+        if (!is.null(value_labels)) {
+          value_labels <- stats::setNames(as.character(value_labels), names(value_labels))
+        }
         haven::labelled(
           x = i,
-          labels = stats::setNames(as.character(value_labels), names(value_labels)),
+          labels = value_labels,
           label = variable_label
         )
       } else {

diff --git a/tests/testthat/test-data_write.R b/tests/testthat/test-data_write.R
@@ -132,3 +132,23 @@ test_that("data_write, no file extension", {
   expect_error(data_write(d, "mytestfile"))
   expect_error(data_write(d, NULL))
 })
+
+
+# writing character vector works for missing value labels ------------------
+
+tmp <- tempfile(fileext = ".sav")
+on.exit(unlink(tmp))
+
+test_that("data_write, existing variable label but missing value labels", {
+  d <- data.frame(
+    a = letters[1:3],
+    stringsAsFactors = FALSE
+  )
+  d$a <- assign_labels(d$a, variable = "First")
+  # expect message, but no error
+  expect_message(data_write(d, tmp), regex = "Preparing")
+
+  # check if data is really the same
+  d2 <- data_read(tmp)
+  expect_identical(d2, d)
+})