New merge_cells command

NAMESPACE

@@ -201,6 +201,7 @@ export(left_border)
 export(left_border_color)
 export(left_border_style)
 export(left_padding)
+export(merge_cells)
 export(na_string)
 export(number_format)
 export(odds)

R/properties.R

@@ -372,6 +372,38 @@ make_getter_setters('colspan', 'cell', check_fun = is.numeric, extra_code = {
 )
 
 
+#' Merge ranges of cells
+#'
+#' @param ht A huxtable.
+#' @param row A row specifier. See [rowspecs] for details. Note that both `row` and `col` must be
+#'   specified.
+#' @param col A column specifier.
+#'
+#' @details
+#' `merge_cells(ht, c(min_row, max_row), c(min_col, max_col))` is equivalent to
+#' ```
+#'   colspan(ht)[min_row, min_col] <- max_col - min_col + 1
+#'   rowspan(ht)[min_row, min_col] <- max_row - min_row + 1
+#' ```
+#' @return The `ht` object.
+#'
+#' @export
+#'
+#' @examples
+merge_cells <- function (ht, row, col) {
+  assert_that(is_huxtable(ht))
+  row <- get_rc_spec(ht, row, 1)
+  col <- get_rc_spec(ht, col, 1)
+  mr <- min(row)
+  mc <- min(col)
+  cs <- diff(range(col)) + 1
+  rs <- diff(range(row)) + 1
+  colspan(ht)[mr, mc] <- cs
+  rowspan(ht)[mr, mc] <- rs
+
+  ht
+}
+
 check_span_shadows <- function (ht, rc, value) {
   value[is.na(value)] <- 1L
   dcells <- if (rc == 'row') display_cells(ht, new_rowspan = value) else display_cells(ht, new_colspan = value)

tests/testthat/test-set-interface.R

@@ -219,6 +219,26 @@ test_that('set_outer_borders() works with non-standard/empty position arguments'
 })
 
 
+test_that('merge_cells() works as expected', {
+  ht <- hux(a = 1:3, b = 1:3)
+  expect_silent(ht2 <- merge_cells(ht, 1, 1:2))
+  expect_silent(ht2 <- merge_cells(ht2, 2:3, 1))
+  expect_equivalent(colspan(ht2), matrix(c(2, 1, 1, 1, 1, 1), 3, 2))
+  expect_equivalent(rowspan(ht2), matrix(c(1, 2, 1, 1, 1, 1), 3, 2))
+
+  expect_silent(ht3 <- merge_cells(ht, 1, everywhere))
+  expect_equivalent(colspan(ht3), matrix(c(2, 1, 1, 1, 1, 1), 3, 2))
+
+  expect_silent(ht4 <- merge_cells(ht, 1:2, 1:2))
+  expect_equivalent(colspan(ht4), matrix(c(2, 1, 1, 1, 1, 1), 3, 2))
+  expect_equivalent(rowspan(ht4), matrix(c(2, 1, 1, 1, 1, 1), 3, 2))
+
+  expect_silent(ht5 <- merge_cells(ht, c(1, 3), 1))
+  expect_equivalent(rowspan(ht5), matrix(c(3, 1, 1, 1, 1, 1), 3, 2))
+
+})
+
+
 test_that('where() works as expected', {
   dfr <- data.frame(a = 1:3, b = letters[1:3], d = 3:1, stringsAsFactors = FALSE)
   expect_equivalent(where(dfr == 3), matrix(c(3, 1, 1, 3), 2, 2))