fix: optimize span_free calls in delete_rows and delete_columns

span_free() is now only called when the deletion actually breaks
a vertical or horizontal span. Previously it was called systematically,
resetting all spans to 1 even when the merge structure was intact.
Add tests to verify span preservation and reset behavior.

Author: davidgohel

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: flextable
 Title: Functions for Tabular Reporting
-Version: 0.9.12.002
+Version: 0.9.12.003
 Authors@R: c(
     person("David", "Gohel", , "david.gohel@ardata.fr", role = c("aut", "cre")),
     person("ArData", role = "cph"),

NEWS.md

@@ -3,6 +3,10 @@
 ## issues
 
 - `padding.left` and `padding.right` are now supported in PDF/LaTeX output.
+- `delete_rows()` and `delete_columns()` no longer reset all spans
+  unconditionally. `span_free()` is now only triggered when the
+  deletion actually breaks a merged cell, preserving existing
+  merge structures in all other cases.
 
 ## new features
 

R/augment_rows.R

@@ -131,10 +131,17 @@ delete_rows_from_part <- function(x, i) {
   x$rowheights <- x$rowheights[-i]
   # hrules
   x$hrule <- x$hrule[-i]
-  # spans
+  # spans — only reset if vertical spans are broken
+  runs <- split(i, cumsum(c(1, diff(i) != 1)))
+  has_broken_vspan <- any(vapply(runs, function(r) {
+    any(colSums(x$spans$columns[r, , drop = FALSE]) != length(r))
+  }, logical(1)))
+
   x$spans$rows <- x$spans$rows[-i, , drop = FALSE]
   x$spans$columns <- x$spans$columns[-i, , drop = FALSE]
-  x <- span_free(x)
+  if (has_broken_vspan) {
+    x <- span_free(x)
+  }
 
   # styles
   x$styles$cells <- delete_style_row(x$styles$cells, i)
@@ -191,12 +198,20 @@ delete_rows <- function(x, i = NULL, part = "body") {
 
 
 delete_colums_from_part <- function(x, j) {
+  j_idx <- which(x$col_keys %in% j)
   # heights
   x$colwidths <- x$colwidths[!x$col_keys %in% j]
-  # spans
-  x$spans$rows <- x$spans$rows[, !x$col_keys %in% j, drop = FALSE]
-  x$spans$columns <- x$spans$columns[, !x$col_keys %in% j, drop = FALSE]
-  x <- span_free(x)
+  # spans — only reset if horizontal spans are broken
+  runs <- split(j_idx, cumsum(c(1, diff(j_idx) != 1)))
+  has_broken_hspan <- any(vapply(runs, function(r) {
+    any(rowSums(x$spans$rows[, r, drop = FALSE]) != length(r))
+  }, logical(1)))
+
+  x$spans$rows <- x$spans$rows[, -j_idx, drop = FALSE]
+  x$spans$columns <- x$spans$columns[, -j_idx, drop = FALSE]
+  if (has_broken_hspan) {
+    x <- span_free(x)
+  }
 
   # styles
   x$styles$cells <- delete_style_col(x$styles$cells, j)

R/merge_flextable.R

@@ -80,13 +80,20 @@ merge_v <- function(x, j = NULL, target = NULL, part = "body", combine = FALSE)
 #' @inheritParams args_x_i_part_no_all
 #' @family flextable merging function
 #' @examples
-#' dummy_df <- data.frame(
-#'   col1 = letters,
-#'   col2 = letters, stringsAsFactors = FALSE
+#' library(flextable)
+#'
+#' schedule <- data.frame(
+#'   time = c("9h", "10h", "11h", "14h", "15h", "16h"),
+#'   monday = c("Math", "Math", "French", "History", "Science", "French"),
+#'   tuesday = c("English", "Math", "Art", "Math", "Math", "French"),
+#'   wednesday = c("Science", "Math", "Science", "English", "English", "French"),
+#'   stringsAsFactors = FALSE
 #' )
-#' ft_merge <- flextable(dummy_df)
-#' ft_merge <- merge_h(x = ft_merge)
-#' ft_merge
+#'
+#' ft <- flextable(schedule)
+#' ft <- theme_box(ft)
+#' ft <- merge_h(ft)
+#' ft
 #' @export
 merge_h <- function(x, i = NULL, part = "body") {
   if (!inherits(x, "flextable")) {

man/merge_h.Rd

@@ -51,3 +51,62 @@ test_that("merged cells can be un-merged", {
   expect_true(all(ft$body$spans$columns == 1))
 })
 
+
+test_that("delete_rows preserves vertical spans when deletion does not break them", {
+  ft <- flextable(data.frame(
+    col1 = rep(letters[1:3], each = 2),
+    col2 = 1:6,
+    stringsAsFactors = FALSE
+  ))
+  ft <- merge_v(ft, j = "col1")
+  expect_equal(ft$body$spans$columns[, 1], c(2, 0, 2, 0, 2, 0), ignore_attr = TRUE)
+
+  # delete rows 5:6 (the "c" group) — no span is broken
+  ft2 <- delete_rows(ft, i = 5:6)
+  expect_equal(ft2$body$spans$columns[, 1], c(2, 0, 2, 0), ignore_attr = TRUE)
+})
+
+test_that("delete_rows resets spans when deletion breaks a vertical span", {
+  ft <- flextable(data.frame(
+    col1 = rep(letters[1:3], each = 2),
+    col2 = 1:6,
+    stringsAsFactors = FALSE
+  ))
+  ft <- merge_v(ft, j = "col1")
+
+  # delete row 3 — breaks the "b" group (rows 3:4)
+  ft2 <- delete_rows(ft, i = 3)
+  expect_true(all(ft2$body$spans$columns == 1))
+  expect_true(all(ft2$body$spans$rows == 1))
+})
+
+test_that("delete_columns preserves horizontal spans when deletion does not break them", {
+  ft <- flextable(data.frame(
+    col1 = c("x", "y"),
+    col2 = c("x", "y"),
+    col3 = c("a", "b"),
+    stringsAsFactors = FALSE
+  ))
+  ft <- merge_h(ft)
+  expect_equal(ft$body$spans$rows[1, ], c(2, 0, 1), ignore_attr = TRUE)
+
+  # delete col3 — no horizontal span is broken
+  ft2 <- delete_columns(ft, j = "col3")
+  expect_equal(ft2$body$spans$rows[1, ], c(2, 0), ignore_attr = TRUE)
+})
+
+test_that("delete_columns resets spans when deletion breaks a horizontal span", {
+  ft <- flextable(data.frame(
+    col1 = c("x", "y"),
+    col2 = c("x", "y"),
+    col3 = c("a", "b"),
+    stringsAsFactors = FALSE
+  ))
+  ft <- merge_h(ft)
+
+  # delete col1 — breaks the horizontal span col1+col2
+  ft2 <- delete_columns(ft, j = "col1")
+  expect_true(all(ft2$body$spans$columns == 1))
+  expect_true(all(ft2$body$spans$rows == 1))
+})
+