[write] restore sep functionality. closes #1199

NEWS.md

@@ -6,7 +6,8 @@
 * Make non consecutive equal sized dims behave similar to non equal sized non consecutive dims. This makes `dims = "A1:A5,C1:D5"` behave similar to `dims = "A1,C1:D1,A2:A5,C2:D5"`.
 * Improvements to the internal C++ code in `wb_add_data()` to avoid string copies. [1184](https://github.com/JanMarvin/openxlsx2/pull/1184)
   This is a continuation of work started in [1177](https://github.com/JanMarvin/openxlsx2/pull/1177) to speedup `wb_add_data()`/`wb_add_data_table()`.
-* Extend the `bookview` handling. It is now possible to add more than one `bookview` using `wb_set_bookview(view = 2L)` and to remove additional `bookview`s with `wb_remove_bookview()`. Available `bookview`s can be inspected with `wb_get_bookview()`.
+* Extend the `bookview` handling. It is now possible to add more than one `bookview` using `wb_set_bookview(view = 2L)` and to remove additional `bookview`s with `wb_remove_bookview()`. Available `bookview`s can be inspected with `wb_get_bookview()`. [1193](https://github.com/JanMarvin/openxlsx2/pull/1193)
+* Actually implement `sep` functionality in `wb_add_data()` and `wb_add_data_table()` for list columns in `x`. [1200](https://github.com/JanMarvin/openxlsx2/pull/1200)
 
 ## Fixes
 

R/openxlsx2-package.R

@@ -180,7 +180,8 @@ openxlsx2_celltype <- c(
   string_nums    = 13,
   cm_formula     = 14,
   hms_time       = 15,
-  currency       = 16
+  currency       = 16,
+  list           = 17
 )
 
 #' Deprecated functions in package *openxlsx2*

R/write.R

@@ -187,6 +187,7 @@ update_cell <- function(x, wb, sheet, cell, colNames = FALSE,
 #' @param dims worksheet dimensions
 #' @param enforce enforce dims
 #' @param shared shared formula
+#' @param sep the separator string used in collapse
 #' @details
 #' The string `"_openxlsx_NA"` is reserved for `openxlsx2`. If the data frame
 #' contains this string, the output will be broken.
@@ -211,19 +212,20 @@ write_data2 <- function(
     wb,
     sheet,
     data,
-    name = NULL,
-    colNames = TRUE,
-    rowNames = FALSE,
-    startRow = 1,
-    startCol = 1,
-    applyCellStyle = TRUE,
+    name            = NULL,
+    colNames        = TRUE,
+    rowNames        = FALSE,
+    startRow        = 1,
+    startCol        = 1,
+    applyCellStyle  = TRUE,
     removeCellStyle = FALSE,
-    na.strings = na_strings(),
-    data_table = FALSE,
-    inline_strings = TRUE,
-    dims = NULL,
-    enforce = FALSE,
-    shared  = FALSE
+    na.strings      = na_strings(),
+    data_table      = FALSE,
+    inline_strings  = TRUE,
+    dims            = NULL,
+    enforce         = FALSE,
+    shared          = FALSE,
+    sep             = ", "
 ) {
 
   dim_sep <- ";"
@@ -244,6 +246,17 @@ write_data2 <- function(
     data[fcts] <- lapply(data[fcts], to_string)
   }
 
+  # convert list to character
+  is_list <- dc == openxlsx2_celltype[["list"]]
+
+  if (any(is_list)) {
+    lsts <- names(dc[is_list])
+    data[lsts] <- lapply(data[lsts], function(col) {
+      vapply(col, FUN = stringi::stri_join, collapse = sep, FUN.VALUE = NA_character_)
+    })
+    dc[is_list] <- openxlsx2_celltype[["character"]]
+  }
+
   # remove xml encoding and reapply it afterwards. until v0.3 encoding was not enforced.
   # until 1.1 formula encoding was applied in write_formula() and missed formulas written
   # as data frames with class formula
@@ -1023,7 +1036,8 @@ write_data_table <- function(
     inline_strings  = inline_strings,
     dims            = if (enforce) odims else dims,
     enforce         = enforce,
-    shared          = shared
+    shared          = shared,
+    sep             = sep
   )
 
   ### Beg: Only in datatable ---------------------------------------------------
@@ -1074,7 +1088,8 @@ write_data_table <- function(
         data_table      = data_table,
         inline_strings  = inline_strings,
         dims            = NULL,
-        enforce         = FALSE
+        enforce         = FALSE,
+        sep             = sep
       )
     }
 

src/helper_functions.cpp

@@ -73,33 +73,37 @@ SEXP openxlsx2_type(SEXP x) {
     case INTSXP:
     case REALSXP: {
       if (Rf_inherits(z, "Date")) {
-      type[i] = short_date;
-    } else if (Rf_inherits(z, "POSIXct")) {
-      type[i] = long_date;
-    } else if (Rf_inherits(z, "accounting")) {
-      type[i] = accounting;
-    } else if (Rf_inherits(z, "percentage")) {
-      type[i] = percentage;
-    } else if (Rf_inherits(z, "scientific")) {
-      type[i] = scientific;
-    } else if (Rf_inherits(z, "comma")) {
-      type[i] = comma;
-    } else if (Rf_inherits(z, "factor") || !Rf_isNull(Rf_getAttrib(z, Rf_install("labels")))) {
-      type[i] = factor;
-    } else if (Rf_inherits(z, "hms")) {
-      type[i] = hms_time;
-    } else if (Rf_inherits(z, "currency")) {
-      type[i] = currency;
-    } else {
-      if (Rf_isNull(Rclass)) {
-        type[i] = numeric; // numeric and integer
+        type[i] = short_date;
+      } else if (Rf_inherits(z, "POSIXct")) {
+        type[i] = long_date;
+      } else if (Rf_inherits(z, "accounting")) {
+        type[i] = accounting;
+      } else if (Rf_inherits(z, "percentage")) {
+        type[i] = percentage;
+      } else if (Rf_inherits(z, "scientific")) {
+        type[i] = scientific;
+      } else if (Rf_inherits(z, "comma")) {
+        type[i] = comma;
+      } else if (Rf_inherits(z, "factor") || !Rf_isNull(Rf_getAttrib(z, Rf_install("labels")))) {
+        type[i] = factor;
+      } else if (Rf_inherits(z, "hms")) {
+        type[i] = hms_time;
+      } else if (Rf_inherits(z, "currency")) {
+        type[i] = currency;
       } else {
-        type[i] = factor; // probably some custom class
+        if (Rf_isNull(Rclass)) {
+          type[i] = numeric; // numeric and integer
+        } else {
+          type[i] = factor; // probably some custom class
+        }
       }
+      break;
     }
-    break;
 
-    }
+    case VECSXP:
+      type[i] = list;
+      break;
+
 
     // whatever is not covered from above
     default: {

src/openxlsx2.h

@@ -19,7 +19,6 @@ inline void checkInterrupt(R_xlen_t iteration, R_xlen_t frequency = 10000) {
   }
 }
 
-
 template <typename T>
 static inline std::string int_to_col(T cell) {
   std::string col_name = "";
@@ -55,7 +54,6 @@ static inline bool has_cell(const std::string& str, const std::unordered_set<std
   return vec.find(str) != vec.end();
 }
 
-
 // driver function for col_to_int
 static inline uint32_t uint_col_to_int(std::string& a) {
 

src/openxlsx2_types.h

@@ -45,7 +45,8 @@ enum celltype {
   string_num     = 13,
   cm_formula     = 14,
   hms_time       = 15,
-  currency       = 16
+  currency       = 16,
+  list           = 17
 };
 
 // check for 1.0.8.0

tests/testthat/test-write.R

@@ -1415,3 +1415,64 @@ test_that("incomplete types work and character types work as well", {
   expect_equal(exp, got)
 
 })
+
+test_that("writing list with sep works", {
+
+  # input data
+  df <- structure(
+    list(
+      CharCol = c("A", "B", "C", "D", "E"),
+      ListCol = list(c("X", "F", "Q", "R", "J"),
+                     c("Q", "E", "O", "E", "O"),
+                     c("X", "O", "F", "Z", "P"),
+                     c("T", "W", "U", "J", "S"),
+                     c("R", "S", "U", "W", "L")
+      )
+    ),
+    class = "data.frame",
+    row.names = c(NA, -5L)
+  )
+
+  wb <- wb_workbook() %>%
+    # basic
+    wb_add_worksheet() %>%
+    wb_add_data(
+      x = df
+    ) %>%
+    wb_add_worksheet() %>%
+    wb_add_data_table(
+      x = df
+    ) %>%
+    # with different sep
+    wb_add_worksheet() %>%
+    wb_add_data(
+      x = df, sep = "_"
+    ) %>%
+    wb_add_worksheet() %>%
+    wb_add_data_table(
+      x = df, sep = "_"
+    )
+
+  # basic
+  exp <- structure(list(CharCol = c("A", "B", "C", "D", "E"),
+                        ListCol = c("X, F, Q, R, J", "Q, E, O, E, O", "X, O, F, Z, P", "T, W, U, J, S", "R, S, U, W, L")),
+                   row.names = 2:6, class = "data.frame")
+
+  got <- wb_to_df(wb, sheet = 1)
+  expect_equal(exp, got)
+
+  got <- wb_to_df(wb, sheet = 2)
+  expect_equal(exp, got)
+
+  # with custom
+  exp <- structure(list(CharCol = c("A", "B", "C", "D", "E"),
+                        ListCol = c("X_F_Q_R_J", "Q_E_O_E_O", "X_O_F_Z_P", "T_W_U_J_S", "R_S_U_W_L")),
+                   row.names = 2:6, class = "data.frame")
+
+  got <- wb_to_df(wb, sheet = 3)
+  expect_equal(exp, got)
+
+  got <- wb_to_df(wb, sheet = 4)
+  expect_equal(exp, got)
+
+})