From 09ae21372329bb1dff3880ce24bffb2a03194efc Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 13:40:16 +0200 Subject: [PATCH 1/5] fix data_write for partially labelled characters --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ R/data_write.R | 8 ++++++-- tests/testthat/test-data_write.R | 16 ++++++++++++++++ 4 files changed, 27 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1144e0b80..bd8bbcea3 100644 --- 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", , "patilindrajeet.science@gmail.com", role = "aut", comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")), diff --git a/NEWS.md b/NEWS.md index c747eb8dc..d1c0a3e52 100644 --- 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 index b8d710d2e..def1cfccc 100644 --- a/R/data_write.R +++ b/R/data_write.R @@ -140,11 +140,15 @@ data_write <- function(data, ) } else if (!is.null(value_labels) || !is.null(variable_label)) { # character requires special preparation to save value labels - # haven:::vec_cast_named requires "x" and "labels" to be of same type + # 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 index a51931bd7..789717530 100644 --- a/tests/testthat/test-data_write.R +++ b/tests/testthat/test-data_write.R @@ -132,3 +132,19 @@ 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, no file extension", { + 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, "test.sav"), regex = "Preparing") +}) From 589ac924e8d214068a8d2fb0184048420c2f1f73 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 13:41:10 +0200 Subject: [PATCH 2/5] remove whitespace --- R/data_write.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/data_write.R b/R/data_write.R index def1cfccc..324b71168 100644 --- a/R/data_write.R +++ b/R/data_write.R @@ -140,7 +140,7 @@ data_write <- function(data, ) } else if (!is.null(value_labels) || !is.null(variable_label)) { # character requires special preparation to save value labels - # haven:::vec_cast_named requires "x" and "labels" to be of same type + # 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)) { From 1d939900b7292d311bd77460422b55178001793e Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 14:00:17 +0200 Subject: [PATCH 3/5] Update tests/testthat/test-data_write.R Co-authored-by: Etienne Bacher <52219252+etiennebacher@users.noreply.github.com> --- tests/testthat/test-data_write.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-data_write.R b/tests/testthat/test-data_write.R index 789717530..0463c16ae 100644 --- a/tests/testthat/test-data_write.R +++ b/tests/testthat/test-data_write.R @@ -139,7 +139,7 @@ test_that("data_write, no file extension", { tmp <- tempfile(fileext = ".sav") on.exit(unlink(tmp)) -test_that("data_write, no file extension", { +test_that("data_write, existing variable label but missing value labels", { d <- data.frame( a = letters[1:3], stringsAsFactors = FALSE From 510dc5a66bbf96842097d23402d5c2e8d7cda456 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 14:04:54 +0200 Subject: [PATCH 4/5] use correct file path --- tests/testthat/test-data_write.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-data_write.R b/tests/testthat/test-data_write.R index 0463c16ae..dd57c6e8c 100644 --- a/tests/testthat/test-data_write.R +++ b/tests/testthat/test-data_write.R @@ -146,5 +146,5 @@ test_that("data_write, existing variable label but missing value labels", { ) d$a <- assign_labels(d$a, variable = "First") # expect message, but no error - expect_message(data_write(d, "test.sav"), regex = "Preparing") + expect_message(data_write(d, tmp), regex = "Preparing") }) From 9dc9bd91ad4af989a46732f5777ff602ff2546b2 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 14 Sep 2023 14:06:18 +0200 Subject: [PATCH 5/5] read back and check --- tests/testthat/test-data_write.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-data_write.R b/tests/testthat/test-data_write.R index dd57c6e8c..861f67b46 100644 --- a/tests/testthat/test-data_write.R +++ b/tests/testthat/test-data_write.R @@ -147,4 +147,8 @@ test_that("data_write, existing variable label but missing value labels", { 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) })