[(un)merge_cells] rm build cell merges

NEWS.md

@@ -10,6 +10,8 @@
 
 * Moved data validation list from x14 to data validation. This enables data validation lists without x14 extension [openxlsx 386](https://github.com/ycphs/openxlsx/issues/386). [347](https://github.com/JanMarvin/openxlsx2/pull/347)
 
+* Removed `build_cell_merges()` and replaced it with a plain R solution. [390](https://github.com/JanMarvin/openxlsx2/pull/390)
+
 ## Fixes
 
 * Fix the workbook xml relationship file to not include a reference to shared strings per default. This solves [360](https://github.com/JanMarvin/openxlsx2/issues/360) for plain data files written from `openxlsx2`. [363](https://github.com/JanMarvin/openxlsx2/pull/363)

R/RcppExports.R

@@ -1,20 +1,6 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-#' this returns the index of the character vector that matches
-#' @param x x
-#' @param row row
-#' @param col col
-#' @keywords internal
-#' @noRd
-NULL
-
-#' convert "TRUE"/"FALSE" to "1"/"0"
-#' @param input input
-#' @keywords internal
-#' @noRd
-NULL
-
 openxlsx2_type <- function(x) {
     .Call(`_openxlsx2_openxlsx2_type`, x)
 }
@@ -47,10 +33,6 @@ wide_to_long <- function(z, vtyps, zz, ColNames, start_col, start_row, ref) {
     invisible(.Call(`_openxlsx2_wide_to_long`, z, vtyps, zz, ColNames, start_col, start_row, ref))
 }
 
-build_cell_merges <- function(comps) {
-    .Call(`_openxlsx2_build_cell_merges`, comps)
-}
-
 #' @param colnames a vector of the names of the data frame
 #' @param n the length of the data frame
 #' @noRd

R/class-workbook.R

@@ -2777,25 +2777,17 @@ wbWorkbook <- R6::R6Class(
       rows <- range(as.integer(rows))
       cols <- range(as.integer(cols))
 
-      # sqref <- get_cell_refs(data.frame(x = rows, y = cols))
       sqref <- paste0(int2col(cols), rows)
+      sqref <- stri_join(sqref, collapse = ":", sep = " ")
 
-      # TODO If the cell merge specs were saved as a data.frame or matrix
-      # this would be quicker to check
-      current <- reg_match0(self$worksheets[[sheet]]$mergeCells, "[A-Z0-9]+:[A-Z0-9]+")
+      current <- rbindlist(xml_attr(xml = self$worksheets[[sheet]]$mergeCells, "mergeCell"))$ref
 
       # regmatch0 will return character(0) when x is NULL
       if (length(current)) {
-        comps <- lapply(
-          current,
-          function(rectCoords) {
-            unlist(strsplit(rectCoords, split = ":"))
-          }
-        )
 
-        current_cells <- build_cell_merges(comps = comps)
-        new_merge <- unlist(build_cell_merges(comps = list(sqref))) # used below in vapply()
-        intersects <- vapply(current_cells, function(x) any(x %in% new_merge), NA)
+        new_merge     <- unname(unlist(dims_to_dataframe(sqref, fill = TRUE)))
+        current_cells <- lapply(current, function(x) unname(unlist(dims_to_dataframe(x, fill = TRUE))))
+        intersects    <- vapply(current_cells, function(x) any(x %in% new_merge), NA)
 
         # Error if merge intersects
         if (any(intersects)) {
@@ -2810,7 +2802,7 @@ wbWorkbook <- R6::R6Class(
         # TODO does this have to be xml?  Can we just save the data.frame or
         # matrix and then check that?  This would also simplify removing the
         # merge specifications
-      private$append_sheet_field(sheet, "mergeCells", sprintf('<mergeCell ref="%s"/>', stri_join(sqref, collapse = ":", sep = " " )))
+      private$append_sheet_field(sheet, "mergeCells", sprintf('<mergeCell ref="%s"/>', sqref))
       invisible(self)
     },
 
@@ -2821,24 +2813,22 @@ wbWorkbook <- R6::R6Class(
     #' @return The `wbWorkbook` object, invisibly
     unmerge_cells = function(sheet = current_sheet(), rows = NULL, cols = NULL) {
       sheet <- private$get_sheet_index(sheet)
+
       rows <- range(as.integer(rows))
       cols <- range(as.integer(cols))
-      # sqref <- get_cell_refs(data.frame(x = rows, y = cols))
+
       sqref <- paste0(int2col(cols), rows)
+      sqref <- stri_join(sqref, collapse = ":", sep = " ")
 
-      current <- regmatches(
-        self$worksheets[[sheet]]$mergeCells,
-        regexpr("[A-Z0-9]+:[A-Z0-9]+", self$worksheets[[sheet]]$mergeCells)
-      )
+      current <- rbindlist(xml_attr(xml = self$worksheets[[sheet]]$mergeCells, "mergeCell"))$ref
 
       if (!is.null(current)) {
-        comps <- lapply(current, function(x) unlist(strsplit(x, split = ":")))
-        current_cells <- build_cell_merges(comps = comps)
-        new <- unlist(build_cell_merges(comps = list(sqref))) # used right below
-        mergeIntersections <- vapply(current_cells, function(x) any(x %in% new), NA)
+        new_merge     <- unname(unlist(dims_to_dataframe(sqref, fill = TRUE)))
+        current_cells <- lapply(current, function(x) unname(unlist(dims_to_dataframe(x, fill = TRUE))))
+        intersects    <- vapply(current_cells, function(x) any(x %in% new_merge), NA)
 
         # Remove intersection
-        self$worksheets[[sheet]]$mergeCells <- self$worksheets[[sheet]]$mergeCells[!mergeIntersections]
+        self$worksheets[[sheet]]$mergeCells <- self$worksheets[[sheet]]$mergeCells[!intersects]
       }
 
       invisible(self)

src/RcppExports.cpp

@@ -107,17 +107,6 @@ BEGIN_RCPP
     return R_NilValue;
 END_RCPP
 }
-// build_cell_merges
-Rcpp::List build_cell_merges(Rcpp::List comps);
-RcppExport SEXP _openxlsx2_build_cell_merges(SEXP compsSEXP) {
-BEGIN_RCPP
-    Rcpp::RObject rcpp_result_gen;
-    Rcpp::RNGScope rcpp_rngScope_gen;
-    Rcpp::traits::input_parameter< Rcpp::List >::type comps(compsSEXP);
-    rcpp_result_gen = Rcpp::wrap(build_cell_merges(comps));
-    return rcpp_result_gen;
-END_RCPP
-}
 // create_char_dataframe
 Rcpp::DataFrame create_char_dataframe(Rcpp::CharacterVector colnames, R_xlen_t n);
 RcppExport SEXP _openxlsx2_create_char_dataframe(SEXP colnamesSEXP, SEXP nSEXP) {
@@ -832,7 +821,6 @@ static const R_CallMethodDef CallEntries[] = {
     {"_openxlsx2_dims_to_df", (DL_FUNC) &_openxlsx2_dims_to_df, 3},
     {"_openxlsx2_long_to_wide", (DL_FUNC) &_openxlsx2_long_to_wide, 3},
     {"_openxlsx2_wide_to_long", (DL_FUNC) &_openxlsx2_wide_to_long, 7},
-    {"_openxlsx2_build_cell_merges", (DL_FUNC) &_openxlsx2_build_cell_merges, 1},
     {"_openxlsx2_create_char_dataframe", (DL_FUNC) &_openxlsx2_create_char_dataframe, 2},
     {"_openxlsx2_col_to_df", (DL_FUNC) &_openxlsx2_col_to_df, 1},
     {"_openxlsx2_df_to_xml", (DL_FUNC) &_openxlsx2_df_to_xml, 2},

src/helper_functions.cpp

@@ -341,74 +341,6 @@ void wide_to_long(Rcpp::DataFrame z, Rcpp::IntegerVector vtyps, Rcpp::DataFrame
   }
 }
 
-//' this returns the index of the character vector that matches
-//' @param x x
-//' @param row row
-//' @param col col
-//' @keywords internal
-//' @noRd
-R_xlen_t select_rows(vec_string &x, std::string row, std::string col) {
-  return std::distance(x.begin(), find(x.begin(), x.end(), col + row));
-}
-
-//' convert "TRUE"/"FALSE" to "1"/"0"
-//' @param input input
-//' @keywords internal
-//' @noRd
-std::string to_int(Rcpp::String input) {
-  if (input == "TRUE") return ("1");
-  else return("0");
-}
-
-// [[Rcpp::export]]
-Rcpp::List build_cell_merges(Rcpp::List comps) {
-
-  size_t nMerges = comps.size();
-  Rcpp::List res(nMerges);
-
-  for (size_t i =0; i < nMerges; i++) {
-    Rcpp::IntegerVector col = col_to_int(comps[i]);
-    Rcpp::CharacterVector comp = comps[i];
-    Rcpp::IntegerVector row(2);
-
-    for (size_t j = 0; j < 2; j++) {
-      std::string rt(comp[j]);
-      rt.erase(std::remove_if(rt.begin(), rt.end(), ::isalpha), rt.end());
-      row[j] = atoi(rt.c_str());
-    }
-
-    size_t ca(col[0]);
-    size_t ck = size_t(col[1]) - ca + 1;
-
-    std::vector<int> v(ck) ;
-    for (size_t j = 0; j < ck; j++)
-      v[j] = j + ca;
-
-    size_t ra(row[0]);
-
-    size_t rk = int(row[1]) - ra + 1;
-    std::vector<int> r(rk) ;
-    for (size_t j = 0; j < rk; j++)
-      r[j] = j + ra;
-
-    Rcpp::CharacterVector M(ck*rk);
-    int ind = 0;
-    for (size_t j = 0; j < ck; j++) {
-      for (size_t k = 0; k < rk; k++) {
-        char name[30];
-        sprintf(&(name[0]), "%d-%d", r[k], v[j]);
-        M(ind) = name;
-        ind++;
-      }
-    }
-
-    res[i] = M;
-  }
-
-  return wrap(res) ;
-
-}
-
 // simple helper function to create a data frame of type character
 //' @param colnames a vector of the names of the data frame
 //' @param n the length of the data frame

tests/testthat/test-fill_merged_cells.R

@@ -36,3 +36,13 @@ test_that("fill merged cells", {
   expect_equal(read_xlsx(tmp_file, rows = 1:3, fillMergedCells = TRUE), r2[1:2, ], ignore_attr = TRUE)
   expect_equal(read_xlsx(tmp_file, cols = 1:3, rows = 1:4, fillMergedCells = TRUE), r2_1[1:3, ], ignore_attr = TRUE)
 })
+
+test_that("merge and unmerge cells", {
+
+  wb <- wb_workbook()$add_worksheet()$merge_cells(rows = 1:2, cols = 1:2)
+
+  expect_error(wb$merge_cells(rows = 1:2, cols = 1:2), "Remove existing merge first.")
+  expect_silent(wb$unmerge_cells(rows = 1:2, cols = 1:2))
+  expect_silent(wb$merge_cells(rows = 1:2, cols = 1:2))
+
+})