From 9b94e2a63ee3530d28d01a9f779538cf5f9e6765 Mon Sep 17 00:00:00 2001
From: Jan Marvin Garbuszus <jan.garbuszus@rub.de>
Date: Sun, 24 Nov 2024 14:51:18 +0100
Subject: [PATCH] [write] improve support for partial labels

---
 NEWS.md                     |  1 +
 R/helper-functions.R        | 10 +++++-----
 tests/testthat/test-write.R | 39 +++++++++++++++++++++++++++++++++++++
 3 files changed, 45 insertions(+), 5 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 5d459ca22..d0993ba4a 100644
--- a/NEWS.md
+++ b/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
 
diff --git a/R/helper-functions.R b/R/helper-functions.R
index 464d8e6de..4bb2aa7dc 100644
--- a/R/helper-functions.R
+++ b/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
 }
diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R
index 6e670537a..ee17ea092 100644
--- a/tests/testthat/test-write.R
+++ b/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, row_names = F)$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()