From e5c5ccf24cd59dd8be97111c97e0408fa4eab78d Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 15 Dec 2024 11:34:48 +0100 Subject: [PATCH] [merge_cells] allow splitting into dimensions (#1212) * [merge_cells] allow splitting into dimensions * [misc] cleanup --- R/class-workbook-wrappers.R | 5 +++-- R/class-workbook.R | 14 +++----------- R/class-worksheet.R | 14 +++++++++++++- R/helper-functions.R | 17 +++++++++-------- man/wbWorkbook.Rd | 3 +++ man/wb_merge_cells.Rd | 11 ++++++++++- tests/testthat/test-fill_merged_cells.R | 12 ++++++++++++ 7 files changed, 53 insertions(+), 23 deletions(-) diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index 4d16186a6..481ece90b 100644 --- a/R/class-workbook-wrappers.R +++ b/R/class-workbook-wrappers.R @@ -903,6 +903,7 @@ wb_copy_cells <- function( #' @param sheet A name or index of a worksheet #' @param dims worksheet cells #' @param solve logical if intersecting merges should be solved +#' @param direction direction in which to split the cell merging. Allows "row" or "col" #' @param ... additional arguments #' #' @examples @@ -934,9 +935,9 @@ wb_copy_cells <- function( #' @family workbook wrappers #' @family worksheet content functions #' @export -wb_merge_cells <- function(wb, sheet = current_sheet(), dims = NULL, solve = FALSE, ...) { +wb_merge_cells <- function(wb, sheet = current_sheet(), dims = NULL, solve = FALSE, direction = NULL, ...) { assert_workbook(wb) - wb$clone(deep = TRUE)$merge_cells(sheet = sheet, dims = dims, solve = solve, ... = ...) + wb$clone(deep = TRUE)$merge_cells(sheet = sheet, dims = dims, solve = solve, direction = direction, ... = ...) } #' @export diff --git a/R/class-workbook.R b/R/class-workbook.R index abb6888dc..06b5a8f29 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -5256,8 +5256,9 @@ wbWorkbook <- R6::R6Class( #' @description #' Set cell merging for a sheet #' @param solve logical if intersecting cells should be solved + #' @param direction direction in which to split the cell merging. Allows "row" or "col". #' @return The `wbWorkbook` object, invisibly - merge_cells = function(sheet = current_sheet(), dims = NULL, solve = FALSE, ...) { + merge_cells = function(sheet = current_sheet(), dims = NULL, solve = FALSE, direction = NULL, ...) { cols <- list(...)[["cols"]] rows <- list(...)[["rows"]] @@ -5273,17 +5274,8 @@ wbWorkbook <- R6::R6Class( dims <- rowcol_to_dims(rows, cols) } - ddims <- dims_to_rowcol(dims) - - rows <- ddims[[2]] - cols <- ddims[[1]] - sheet <- private$get_sheet_index(sheet) - self$worksheets[[sheet]]$merge_cells( - rows = rows, - cols = cols, - solve = solve - ) + self$worksheets[[sheet]]$merge_cells(dims = dims, solve = solve, direction = direction) invisible(self) }, diff --git a/R/class-worksheet.R b/R/class-worksheet.R index d78660684..a169a0306 100644 --- a/R/class-worksheet.R +++ b/R/class-worksheet.R @@ -514,8 +514,14 @@ wbWorksheet <- R6::R6Class( #' Set cell merging for a sheet #' @param rows,cols Row and column specifications. #' @param solve logical if intersects should be solved + #' @param direction direction in which to split #' @return The `wbWorkbook` object, invisibly - merge_cells = function(rows = NULL, cols = NULL, solve = FALSE) { + merge_cells = function(dims = NULL, solve = FALSE, direction = NULL) { + + ddims <- dims_to_rowcol(dims) + + rows <- ddims[[2]] + cols <- ddims[[1]] rows <- range(as.integer(rows)) cols <- range(col2int(cols)) @@ -556,6 +562,12 @@ wbWorksheet <- R6::R6Class( } } + if (!is.null(direction)) { + if (direction == "row") direction <- 1 + if (direction == "col") direction <- 2 + sqref <- split_dims(sqref, direction = direction) + } + self$append("mergeCells", sprintf('', sqref)) invisible(self) diff --git a/R/helper-functions.R b/R/helper-functions.R index bcce5a338..559538968 100644 --- a/R/helper-functions.R +++ b/R/helper-functions.R @@ -383,13 +383,8 @@ hashPassword <- function(password) { } # Helper to split a cell range into rows or columns -split_dims <- function(dims, direction = NULL, preserve_single = FALSE) { +split_dims <- function(dims, direction = "row") { df <- dims_to_dataframe(dims, fill = TRUE, empty_rm = TRUE) - - if (preserve_single && is.null(direction) && any(dim(df) == 1)) { - return(dims) - } - if (is.null(direction)) direction <- "row" if (is.numeric(direction)) { if (direction == 1) direction <- "row" if (direction == 2) direction <- "col" @@ -410,6 +405,10 @@ split_dim <- function(dims) { unlist(df) } +is_single_cell <- function(dims) { + all(lengths(dims_to_rowcol(dims)) == 1) +} + #' Create sparklines object #' #' Create a sparkline to be added a workbook with [wb_add_sparklines()] @@ -540,8 +539,10 @@ create_sparklines <- function( if (!is.null(markers) && as_xml_attr(markers) == "" && !is.null(type) && type %in% c("stacked", "column")) stop("markers only affect lines `type = NULL`, not stacked or column") - dims <- split_dims(dims, direction = direction, preserve_single = TRUE) - sqref <- split_dim(sqref) + if (!is.null(direction) || !is_single_cell(sqref)) { + dims <- split_dims(dims, direction = direction) + sqref <- split_dim(sqref) + } if (length(dims) != 1 && length(dims) != length(sqref)) { stop("dims and sqref must be equal length.") diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index 7e6d2ebd9..a0e2c6d3b 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -1859,6 +1859,7 @@ Set cell merging for a sheet sheet = current_sheet(), dims = NULL, solve = FALSE, + direction = NULL, ... )}\if{html}{\out{}} } @@ -1872,6 +1873,8 @@ Set cell merging for a sheet \item{\code{solve}}{logical if intersecting cells should be solved} +\item{\code{direction}}{direction in which to split the cell merging. Allows "row" or "col".} + \item{\code{...}}{additional arguments} } \if{html}{\out{}} diff --git a/man/wb_merge_cells.Rd b/man/wb_merge_cells.Rd index 878383995..47e50fae0 100644 --- a/man/wb_merge_cells.Rd +++ b/man/wb_merge_cells.Rd @@ -5,7 +5,14 @@ \alias{wb_unmerge_cells} \title{Merge cells within a worksheet} \usage{ -wb_merge_cells(wb, sheet = current_sheet(), dims = NULL, solve = FALSE, ...) +wb_merge_cells( + wb, + sheet = current_sheet(), + dims = NULL, + solve = FALSE, + direction = NULL, + ... +) wb_unmerge_cells(wb, sheet = current_sheet(), dims = NULL, ...) } @@ -18,6 +25,8 @@ wb_unmerge_cells(wb, sheet = current_sheet(), dims = NULL, ...) \item{solve}{logical if intersecting merges should be solved} +\item{direction}{direction in which to split the cell merging. Allows "row" or "col"} + \item{...}{additional arguments} } \description{ diff --git a/tests/testthat/test-fill_merged_cells.R b/tests/testthat/test-fill_merged_cells.R index 9219697d8..47afbca86 100644 --- a/tests/testthat/test-fill_merged_cells.R +++ b/tests/testthat/test-fill_merged_cells.R @@ -107,3 +107,15 @@ test_that("solving merge conflicts works", { expect_equal(exp, got) }) + +test_that("merging with direction works", { + wb <- wb_workbook()$add_worksheet()$ + merge_cells(dims = "A1:C3", direction = "row")$ + merge_cells(dims = "A4:C6", direction = "col") + + exp <- c("", "", + "", "", + "", "") + got <- wb$worksheets[[1]]$mergeCells + expect_equal(exp, got) +})