[write] improve support for partial labels (#1189)

NEWS.md

@@ -11,6 +11,7 @@
 
 * Create date is not reset to the present time in each call to `wb_set_properties()`. [1176](https://github.com/JanMarvin/openxlsx2/pull/1176)
 * Improve handling of file headers and footers for a case where `wb_load()` would previously fail. [1186](https://github.com/JanMarvin/openxlsx2/pull/1186)
+* Partial labels were written only over the first element and only if assigned in an ordered fashion. [1189](https://github.com/JanMarvin/openxlsx2/pull/1189)
 
 ## Breaking changes
 

R/helper-functions.R

@@ -597,11 +597,11 @@ write_workbook.xml.rels <- function(x, rm_sheet = NULL) {
 #' @noRd
 to_string <- function(x) {
   lbls <- attr(x, "labels")
-  chr <- as.character(x)
-  if (!is.null(lbls)) {
-    lbls <- lbls[lbls %in% x]
-    sel_l <- match(lbls, x)
-    if (length(sel_l)) chr[sel_l] <- names(lbls)
+  chr  <- as.character(x)
+  if (!is.null(lbls) && !is.null(names(lbls))) {
+    lbls <- lbls[match(x, lbls)]
+    sel_l <- which(!is.na(lbls))
+    if (length(sel_l)) chr[sel_l] <- names(lbls[!is.na(lbls)])
   }
   chr
 }

tests/testthat/test-write.R

@@ -914,6 +914,45 @@ test_that("writing labeled variables works", {
 
 })
 
+test_that("partial labels work", {
+  vec <- sample(c(0, 1, 2), size = 10, replace = TRUE)
+
+  df <- data.frame(
+    var1 = vec,
+    var2 = vec,
+    var3 = vec,
+    var4 = vec,
+    var5 = vec,
+    var6 = vec,
+    var7 = ifelse(vec == 0, "No", ifelse(vec == 1, "Yes", "Maybe"))
+  )
+
+  attr(df$var1, "labels") <- c(No = 0, Yes = 1, Maybe = 2)       # ordered labels
+  attr(df$var2, "labels") <- c(Yes = 1, Maybe = 2, No = 0)       # unordered labels
+  attr(df$var3, "labels") <- c(Yes = 1, Maybe = 2)               # partial labels
+  attr(df$var4, "labels") <- c(No = 0, Maybe = 2)                # partial labels
+  attr(df$var5, "labels") <- c(Undecided = -1)                   # unmatched label
+
+  df$var6 <- factor(df$var6, levels = c(1, 0, 2), label = c("Yes", "No", "Maybe"))
+
+
+  got <- write_xlsx(x = df)$to_df()
+  expect_equal(got$var1, got$var7)
+  expect_equal(got$var2, got$var7)
+  expect_equal(which(got$var3 != "0"), which(got$var7 != "No"))
+  expect_equal(which(got$var3 == "0"), which(got$var7 == "No"))
+
+  expect_equal(which(got$var4 != "1"), which(got$var7 != "Yes"))
+  expect_equal(which(got$var4 == "1"), which(got$var7 == "Yes"))
+
+  expect_equal(which(got$var5 == "0"), which(got$var7 == "No"))
+  expect_equal(which(got$var5 == "1"), which(got$var7 == "Yes"))
+  expect_equal(which(got$var5 == "2"), which(got$var7 == "Maybe"))
+
+  expect_equal(got$var6, got$var7)
+
+})
+
 test_that("writing in specific encoding works", {
 
   skip_on_cran()