test-patchwork.R
In flextable: Functions for Tabular Reporting

skip_if_not_installed("patchwork")
skip_if_not_installed("ggplot2")
skip_if_not_installed("gtable")

gdtools::register_liberationsans()

init_flextable_defaults()
set_flextable_defaults(
  font.family = "Liberation Sans",
  border.color = "#333333"
)

make_ft <- function(n = 3) {
  dat <- data.frame(
    label = head(LETTERS, n),
    value = seq_len(n)
  )
  autofit(flextable(dat))
}

make_ft_with_footer <- function() {
  ft <- make_ft()
  ft <- add_footer_lines(ft, values = "a note")
  autofit(ft)
}

# -- wrap_flextable ----------------------------------------------------------

test_that("wrap_flextable returns a wrapped_table", {
  ft <- make_ft()
  w <- wrap_flextable(ft)
  expect_s3_class(w, "wrapped_table")
  expect_s3_class(w, "wrapped_patch")
})

test_that("wrap_flextable panel argument is validated", {
  ft <- make_ft()
  expect_error(wrap_flextable(ft, panel = "invalid"), "should be one of")
  for (p in c("body", "full", "rows", "cols")) {
    w <- wrap_flextable(ft, panel = p)
    expect_equal(attr(w, "patch_settings")$panel, p)
  }
})

test_that("wrap_flextable space argument sets free axes", {
  ft <- make_ft()

  w_fixed <- wrap_flextable(ft, space = "fixed")
  expect_equal(attr(w_fixed, "patch_settings")$space, c(FALSE, FALSE))

  w_free <- wrap_flextable(ft, space = "free")
  expect_equal(attr(w_free, "patch_settings")$space, c(TRUE, TRUE))

  w_fx <- wrap_flextable(ft, space = "free_x")
  expect_equal(attr(w_fx, "patch_settings")$space, c(TRUE, FALSE))

  w_fy <- wrap_flextable(ft, space = "free_y")
  expect_equal(attr(w_fy, "patch_settings")$space, c(FALSE, TRUE))
})

test_that("wrap_flextable flex_body forces free y", {
  ft <- make_ft()
  w <- wrap_flextable(ft, space = "fixed", flex_body = TRUE)
  space <- attr(w, "patch_settings")$space
  expect_true(space[2])
})

test_that("wrap_flextable flex_cols forces free x", {
  ft <- make_ft()
  w <- wrap_flextable(ft, space = "fixed", flex_cols = TRUE, n_row_headers = 1)
  space <- attr(w, "patch_settings")$space
  expect_true(space[1])
  expect_equal(attr(w, "patch_settings")$n_row_headers, 1L)
})

test_that("wrap_flextable just is forwarded to as_patch viewport", {
  ft <- make_ft()
  expected_x <- c(left = 0, right = 1, center = 0.5)
  for (j in c("left", "right", "center")) {
    w <- wrap_flextable(ft, just = j)
    # The just attribute is on the inner flextable; verify via as_patch
    ft_inner <- ft
    attr(ft_inner, ".patchwork_just") <- j
    gt <- flextable:::as_patch.flextable(ft_inner)
    expect_equal(as.numeric(gt$vp$x), expected_x[[j]])
  }
})

# -- as_patch.flextable (S3, explicit name for covr) -------------------------

test_that("as_patch.flextable returns a gtable", {
  ft <- make_ft()
  gt <- flextable:::as_patch.flextable(ft)
  expect_s3_class(gt, "gtable")
  expect_true(!is.null(gt$vp))
})

test_that("as_patch.flextable dimensions match flextable", {
  ft <- make_ft()
  gt <- flextable:::as_patch.flextable(ft)

  n_header <- nrow_part(ft, "header")
  n_body <- nrow_part(ft, "body")
  expected_rows <- n_header + n_body
  expect_equal(nrow(gt), expected_rows)
  expect_equal(ncol(gt), ncol_keys(ft))
})

test_that("as_patch.flextable with footer adds rows", {
  ft <- make_ft_with_footer()
  gt <- flextable:::as_patch.flextable(ft)

  n_header <- nrow_part(ft, "header")
  n_body <- nrow_part(ft, "body")
  n_footer <- nrow_part(ft, "footer")
  expect_equal(nrow(gt), n_header + n_body + n_footer)
})

test_that("as_patch.flextable has table_body grob", {
  ft <- make_ft()
  gt <- flextable:::as_patch.flextable(ft)
  grob_names <- gt$layout$name
  expect_true("table" %in% grob_names)
  expect_true("table_body" %in% grob_names)
})

test_that("as_patch.flextable body grob spans correct rows", {
  ft <- make_ft()
  gt <- flextable:::as_patch.flextable(ft)

  body_layout <- gt$layout[gt$layout$name == "table_body", ]
  n_header <- nrow_part(ft, "header")
  n_body <- nrow_part(ft, "body")
  expect_equal(body_layout$t, n_header + 1L)
  expect_equal(body_layout$b, n_header + n_body)
})

test_that("as_patch.flextable flex_body uses null units for body rows", {
  ft <- make_ft()
  attr(ft, ".patchwork_flex_body") <- TRUE
  gt <- flextable:::as_patch.flextable(ft)

  n_header <- nrow_part(ft, "header")
  n_body <- nrow_part(ft, "body")
  body_seq <- seq.int(n_header + 1L, n_header + n_body)

  row_units <- grid::unitType(gt$heights)
  for (i in body_seq) {
    expect_equal(row_units[i], "null")
  }

  if (n_header > 0) {
    for (i in seq_len(n_header)) {
      expect_equal(row_units[i], "inches")
    }
  }
})

test_that("as_patch.flextable flex_cols uses null units for data columns", {
  ft <- make_ft()
  attr(ft, ".patchwork_flex_cols") <- TRUE
  attr(ft, ".patchwork_n_row_headers") <- 1L
  attr(ft, ".patchwork_flex_cols_expand") <- 0.6
  gt <- flextable:::as_patch.flextable(ft)

  n_cols <- ncol_keys(ft)
  data_seq <- seq.int(2L, n_cols)

  col_units <- grid::unitType(gt$widths)
  for (i in data_seq) {
    expect_equal(col_units[i], "null")
  }
  expect_equal(col_units[1], "inches")
})

test_that("as_patch.flextable just controls viewport x", {
  ft <- make_ft()

  attr(ft, ".patchwork_just") <- "left"
  gt_left <- flextable:::as_patch.flextable(ft)
  expect_equal(as.numeric(gt_left$vp$x), 0)

  attr(ft, ".patchwork_just") <- "right"
  gt_right <- flextable:::as_patch.flextable(ft)
  expect_equal(as.numeric(gt_right$vp$x), 1)

  attr(ft, ".patchwork_just") <- "center"
  gt_center <- flextable:::as_patch.flextable(ft)
  expect_equal(as.numeric(gt_center$vp$x), 0.5)
})

# -- ggplot_add.flextable (S3, explicit name for covr) -----------------------

test_that("ggplot_add.flextable wraps and adds to plot", {
  ft <- make_ft()
  p <- ggplot2::ggplot(data.frame(x = 1:3, y = 1:3), ggplot2::aes(x, y)) +
    ggplot2::geom_point()

  result <- flextable:::ggplot_add.flextable(ft, p, "ft")
  expect_s3_class(result, "patchwork")
})

# -- rendering with ragg (end-to-end) ----------------------------------------

test_that("patchwork composition renders to PNG with ragg", {
  ft <- make_ft()
  p <- ggplot2::ggplot(data.frame(x = 1:3, y = 1:3), ggplot2::aes(x, y)) +
    ggplot2::geom_point() +
    ggplot2::theme_minimal(base_family = "Liberation Sans")

  pw <- wrap_flextable(ft) + p

  tf <- tempfile(fileext = ".png")
  on.exit(unlink(tf), add = TRUE)

  ragg::agg_png(filename = tf, width = 8, height = 4, units = "in", res = 150)
  print(pw)
  dev.off()

  expect_true(file.exists(tf))
  expect_gt(file.info(tf)$size, 1000)
})

test_that("patchwork with flex_body renders to PNG with ragg", {
  ft <- make_ft()
  p <- ggplot2::ggplot(
    data.frame(x = 1:3, y = factor(LETTERS[1:3], levels = rev(LETTERS[1:3]))),
    ggplot2::aes(x, y)
  ) +
    ggplot2::geom_col() +
    ggplot2::theme_minimal(base_family = "Liberation Sans")

  pw <- wrap_flextable(ft, flex_body = TRUE) + p

  tf <- tempfile(fileext = ".png")
  on.exit(unlink(tf), add = TRUE)

  ragg::agg_png(filename = tf, width = 8, height = 4, units = "in", res = 150)
  print(pw)
  dev.off()

  expect_true(file.exists(tf))
  expect_gt(file.info(tf)$size, 1000)
})

test_that("patchwork with flex_cols renders to PNG with ragg", {
  ft <- make_ft()
  p <- ggplot2::ggplot(
    data.frame(x = factor(c("label", "value")), y = c(10, 20)),
    ggplot2::aes(x, y)
  ) +
    ggplot2::geom_col() +
    ggplot2::theme_minimal(base_family = "Liberation Sans")

  pw <- wrap_flextable(ft, flex_cols = TRUE, n_row_headers = 0) / p

  tf <- tempfile(fileext = ".png")
  on.exit(unlink(tf), add = TRUE)

  ragg::agg_png(filename = tf, width = 6, height = 6, units = "in", res = 150)
  print(pw)
  dev.off()

  expect_true(file.exists(tf))
  expect_gt(file.info(tf)$size, 1000)
})

test_that("patchwork with just right renders to PNG with ragg", {
  ft <- make_ft()
  p <- ggplot2::ggplot(data.frame(x = 1:3, y = 1:3), ggplot2::aes(x, y)) +
    ggplot2::geom_point() +
    ggplot2::theme_minimal(base_family = "Liberation Sans")

  pw <- wrap_flextable(ft, just = "right") + p

  tf <- tempfile(fileext = ".png")
  on.exit(unlink(tf), add = TRUE)

  ragg::agg_png(filename = tf, width = 8, height = 4, units = "in", res = 150)
  print(pw)
  dev.off()

  expect_true(file.exists(tf))
  expect_gt(file.info(tf)$size, 1000)
})

init_flextable_defaults()