Pagination and column widths handling (#937)

Fixes #924 and #925

NEWS.md

@@ -1,5 +1,12 @@
 ## rtables 0.6.10.9000
 
+### New Features
+ * Experimental pagination is now possible in `tt_as_flextable()` and `export_as_docx()`.
+ * Added handling of widths in `tt_as_flextable()`. Now it is possible to change column widths for `.docx` exports.
+
+### Bug Fixes
+ * Fixed bug that was keeping indentation space characters in top left information when making a `flextable` from a `TableTree` object.
+
 ## rtables 0.6.10
 
 ### New Features

R/tt_as_flextable.R

@@ -30,10 +30,27 @@
 #' @param paginate (`flag`)\cr when exporting `.docx` documents using `export_as_docx`, we suggest relying on the
 #'   Microsoft Word pagination system. If `TRUE`, this option splits `tt` into different "pages" as multiple
 #'   `flextables`. Cooperation between the two mechanisms is not guaranteed. Defaults to `FALSE`.
-#' @param total_width (`numeric(1)`)\cr total width (in inches) for the resulting flextable(s). Defaults to 10.
+#' @param total_page_width (`numeric(1)`)\cr total page width (in inches) for the resulting flextable(s). Any values
+#'   added for column widths is normalized by the total page width. Defaults to 10. If `autofit_to_page = TRUE`, this
+#'   value is automatically set to the allowed page width.
+#' @param total_page_height (`numeric(1)`)\cr total page height (in inches) for the resulting flextable(s). Used only
+#'   to estimate number of lines per page (`lpp`) when `paginate = TRUE`. Defaults to 10.
+#' @param colwidths (`numeric`)\cr column widths for the resulting flextable(s). If `NULL`, the column widths estimated
+#'   with [formatters::propose_column_widths()] will be used. When exporting into `.docx` these values are normalized
+#'   to represent a fraction of the `total_page_width`. If these are specified, `autofit_to_page` is set to `FALSE`.
+#' @param autofit_to_page (`flag`)\cr defaults to `TRUE`. If `TRUE`, the column widths are automatically adjusted to
+#'   fit the total page width. If `FALSE`, the `colwidths` are used as an indicative proportion of `total_page_width`.
+#'   See `flextable::set_table_properties(layout)` for more details.
+#' @param ... (`any`)\cr additional parameters to be passed to the pagination function. See [paginate_table()]
+#'   for further details.
 #'
 #' @return A `flextable` object.
 #'
+#' @note
+#' Currently `cpp`, `tf_wrap`, and `max_width` are only used in pagination and do not yet have a
+#' clear cooperation with `colwidths` and `autofit_to_page`. at the moment it is suggested to use the `cpp`
+#' parameter family cautiously. If issues arise, please communicate with the maintainers or raise an issue.
+#'
 #' @details
 #' Themes can also be extended when you need only a minor change from a default style. You can either
 #' add your own theme to the theme call (e.g. `c(theme_docx_default(), my_theme)`) or create a new
@@ -97,30 +114,81 @@ tt_to_flextable <- function(tt,
                             colwidths = NULL,
                             tf_wrap = !is.null(cpp),
                             max_width = cpp,
-                            total_width = 10) {
+                            total_page_height = 10, # portrait 11 landscape  8.5
+                            total_page_width = 10, # portrait 8.5 landscape  11
+                            autofit_to_page = TRUE) {
   check_required_packages("flextable")
   if (!inherits(tt, "VTableTree")) {
     stop("Input table is not an rtables' object.")
   }
   checkmate::assert_flag(titles_as_header)
   checkmate::assert_flag(footers_as_text)
   checkmate::assert_flag(counts_in_newline)
+  checkmate::assert_flag(autofit_to_page)
+  checkmate::assert_number(total_page_width, lower = 1)
+  checkmate::assert_number(total_page_height, lower = 1)
+  checkmate::assert_numeric(colwidths, lower = 0, len = ncol(tt) + 1, null.ok = TRUE)
+  if (!is.null(colwidths)) {
+    autofit_to_page <- FALSE
+  }
+
   left_right_fixed_margins <- word_mm_to_pt(1.9)
 
   ## if we're paginating, just call -> pagination happens also afterwards if needed
   if (paginate) {
+    # Lets find out the row heights in inches with flextable
+    # Capture all current arguments in a list
+    args <- as.list(environment())
+
+    # Modify the 'paginate' argument
+    args$paginate <- FALSE
+
+    # Use do.call to call the same function with modified arguments
+    tmp_flx <- do.call(tt_to_flextable, args)
+
+    # Determine line per pages (lpp) expected from heights of rows (in inches)
+    row_heights <- dim(tmp_flx)$heights
+    nr_header <- flextable::nrow_part(tmp_flx, part = "header")
+    nr_body <- flextable::nrow_part(tmp_flx, part = "body")
+    nr_footer <- flextable::nrow_part(tmp_flx, part = "footer")
+    if (sum(nr_header, nr_body, nr_footer) != length(row_heights)) {
+      stop("Something went wrong with the row heights. Maybe \\n? Contact maintener.") # nocov
+    }
+    rh_df <- data.frame(rh = row_heights, part = c(
+      rep("header", nr_header), rep("body", nr_body), rep("footer", nr_footer)
+    ))
+    needed_height_header_footer <- sum(rh_df$rh[rh_df$part %in% c("header", "footer")])
+    starting_lpp <- nr_header + nr_footer
+    cumsum_page_heights <- needed_height_header_footer + cumsum(rh_df$rh[rh_df$part == "body"])
+    expected_lpp <- starting_lpp + max(which(cumsum_page_heights < total_page_height))
     if (is.null(lpp)) {
-      stop("lpp must be specified when calling tt_to_flextable with paginate=TRUE")
+      lpp <- expected_lpp
+    } else if (expected_lpp < lpp) {
+      # lpp needs to be estimated along with cpp if not provided
+      warning(
+        "lpp is too large for the given total_page_height. Change the parameters or",
+        " each table will be too long to fit each page."
+      )
     }
     tabs <- paginate_table(tt,
       fontspec = fontspec,
-      lpp = lpp, cpp = cpp,
-      tf_wrap = tf_wrap, max_width = max_width, ...
+      lpp = lpp,
+      cpp = cpp, tf_wrap = tf_wrap, max_width = max_width, # This can only be trial an error
+      ...
     )
     cinds <- lapply(tabs, function(tb) c(1, .figure_out_colinds(tb, tt) + 1L))
+    args$colwidths <- NULL
+    args$tt <- NULL
+    cl <- if (!is.null(colwidths)) {
+      lapply(cinds, function(ci) colwidths[ci])
+    } else {
+      lapply(cinds, function(ci) {
+        return(NULL)
+      })
+    }
     return(mapply(tt_to_flextable,
-      tt = tabs, colwidths = cinds,
-      MoreArgs = list(paginate = FALSE, total_width = total_width),
+      tt = tabs, colwidths = cl,
+      MoreArgs = args,
       SIMPLIFY = FALSE
     ))
   }
@@ -275,6 +343,7 @@ tt_to_flextable <- function(tt,
   for (i in seq_len(nr_header)) {
     leading_spaces_count <- nchar(hdr[i, 1]) - nchar(stringi::stri_replace(hdr[i, 1], regex = "^ +", ""))
     header_indent_size <- leading_spaces_count * word_mm_to_pt(1)
+    hdr[i, 1] <- stringi::stri_replace(hdr[i, 1], regex = "^ +", "")
 
     # This solution does not keep indentation
     # top_left_tmp2 <- paste0(top_left_tmp, collapse = "\n") %>%
@@ -313,10 +382,6 @@ tt_to_flextable <- function(tt,
     # what about margins?
     colwidths <- propose_column_widths(matform, fontspec = fontspec, indent_size = indent_size)
   }
-  final_cwidths <- total_width * colwidths / sum(colwidths) # xxx to fix
-  # xxx FIXME missing transformer from character based widths to mm or pt
-
-  flx <- flextable::width(flx, width = final_cwidths) # xxx to fix
 
   # Title lines (after theme for problems with lines)
   if (titles_as_header && length(all_titles(tt)) > 0 && any(nzchar(all_titles(tt)))) {
@@ -327,8 +392,21 @@ tt_to_flextable <- function(tt,
       )
   }
 
+  # xxx FIXME missing transformer from character based widths to mm or pt
+  final_cwidths <- total_page_width * colwidths / sum(colwidths)
+
+  flx <- flextable::width(flx, width = final_cwidths)
+
   # These final formatting need to work with colwidths
-  flx <- flextable::set_table_properties(flx, layout = "autofit", align = "left") # xxx to fix
+  flx <- flextable::set_table_properties(flx,
+    layout = ifelse(autofit_to_page, "autofit", "fixed"),
+    align = "left",
+    opts_word = list(
+      "split" = FALSE,
+      "keep_with_next" = TRUE
+    )
+  )
+
   # NB: autofit or fixed may be switched if widths are correctly staying in the page
   flx <- flextable::fix_border_issues(flx) # Fixes some rendering gaps in borders
 

R/tt_export.R

@@ -110,7 +110,7 @@ formatters::export_as_pdf
 #' @param ... (`any`)\cr additional arguments passed to [tt_to_flextable()].
 #'
 #' @note `export_as_docx()` has few customization options available. If you require specific formats and details,
-#'   we suggest that you use [tt_to_flextable()] prior to `export_as_docx`. Only the `title_as_header` and
+#'   we suggest that you use [tt_to_flextable()] prior to `export_as_docx`. Only the `titles_as_header` and
 #'   `footer_as_text` parameters must be re-specified if the table is changed first using [tt_to_flextable()].
 #'
 #' @seealso [tt_to_flextable()]
@@ -162,8 +162,36 @@ export_as_docx <- function(tt,
       fpt <- officer::fp_text(font.family = font_fam, font.size = font_sz_body)
       fpt_footer <- officer::fp_text(font.family = font_fam, font.size = font_sz_footer)
     }
-  } else {
+  } else if (inherits(tt, "flextable")) {
     flex_tbl <- tt
+  } else if (inherits(tt, "list")) {
+    export_as_docx(tt[[1]], # First paginated table that uses template_file
+      file = file,
+      doc_metadata = doc_metadata,
+      titles_as_header = titles_as_header,
+      footers_as_text = footers_as_text,
+      template_file = template_file,
+      section_properties = section_properties,
+      ...
+    )
+    if (length(tt) > 1) {
+      out <- mapply(
+        export_as_docx,
+        tt = tt[-1], # Remaining paginated tables
+        MoreArgs = list(
+          file = file,
+          doc_metadata = doc_metadata,
+          titles_as_header = titles_as_header,
+          footers_as_text = footers_as_text,
+          template_file = file, # Uses the just-created file as template
+          section_properties = section_properties,
+          ...
+        )
+      )
+    }
+    return()
+  } else {
+    stop("The table must be a VTableTree, a flextable, or a list of VTableTree or flextable objects.")
   }
   if (!is.null(template_file) && !file.exists(template_file)) {
     template_file <- NULL
@@ -176,8 +204,21 @@ export_as_docx <- function(tt,
     doc <- officer::read_docx()
   }
 
-  if (!is.null(section_properties)) {
-    doc <- officer::body_set_default_section(doc, section_properties)
+  # page width and orientation settings
+  doc <- officer::body_set_default_section(doc, section_properties)
+  if (flex_tbl$properties$layout != "autofit") { # fixed layout
+    page_width <- section_properties$page_size$width
+    dflx <- dim(flex_tbl)
+    if (abs(sum(unname(dflx$widths)) - page_width) > 1e-2) {
+      warning(
+        "The total table width does not match the page width. The column widths",
+        " will be resized to fit the page. Please consider modifying the parameter",
+        " total_page_width in tt_to_flextable()."
+      )
+
+      final_cwidths <- page_width * unname(dflx$widths) / sum(unname(dflx$widths))
+      flex_tbl <- flextable::width(flex_tbl, width = final_cwidths)
+    }
   }
 
   # Extract title
@@ -212,6 +253,8 @@ export_as_docx <- function(tt,
 
   # Save the Word document to a file
   print(doc, target = file)
+
+  invisible(TRUE)
 }
 
 # Shorthand to add text paragraph

tests/testthat/test-exporters.R

@@ -274,3 +274,24 @@ test_that("export_as_doc works thanks to tt_to_flextable", {
 
   expect_true(file.exists(doc_file))
 })
+
+test_that("export_as_doc produces a warning if manual column widths are used", {
+  skip_if_not_installed("flextable")
+  require("flextable", quietly = TRUE)
+
+  lyt <- basic_table() %>%
+    split_rows_by("Species") %>%
+    analyze("Petal.Length")
+  tbl <- build_table(lyt, iris)
+
+  doc_file <- tempfile(fileext = ".docx")
+
+  # Get the flextable
+  expect_warning(
+    export_as_docx(tbl,
+      colwidths = c(1, 2),
+      file = doc_file,
+      section_properties = section_properties_default()
+    ), "The total table width does not match the page width"
+  )
+})

tests/testthat/test-tt_as_flextable.R

@@ -21,7 +21,7 @@ test_that("Can create flextable object that works with different styles", {
 
 
   tbl <- build_table(lyt, ex_adsl)
-  ft <- tt_to_flextable(tbl, total_width = 20)
+  ft <- tt_to_flextable(tbl, total_page_width = 20)
   expect_equal(sum(unlist(nrow(ft))), 20)
 
   expect_silent(ft3 <- tt_to_flextable(tbl, theme = NULL))
@@ -142,5 +142,42 @@ test_that("check pagination", {
   main_footer(tbl) <- c("Some Footer", "Mehr")
   prov_footer(tbl) <- "Some prov Footer"
 
-  expect_silent(out <- tt_to_flextable(tbl, paginate = TRUE, lpp = 100))
+  expect_warning(out <- tt_to_flextable(tbl, paginate = TRUE, lpp = 100))
+  expect_equal(length(out), 3L)
+})
+
+
+test_that("check colwidths in flextable object", {
+  skip_if_not_installed("flextable")
+  require("flextable", quietly = TRUE)
+
+  lyt <- basic_table(show_colcounts = TRUE) %>%
+    split_rows_by("ARM", label_pos = "topleft", page_by = TRUE) %>%
+    split_rows_by("STRATA1", label_pos = "topleft") %>%
+    split_cols_by("STRATA1", split_fun = keep_split_levels("B"), show_colcounts = TRUE) %>%
+    split_cols_by("SEX", split_fun = keep_split_levels(c("F", "M"))) %>%
+    split_cols_by("COUNTRY", split_fun = keep_split_levels("CHN")) %>%
+    analyze("AGE")
+
+  tbl <- build_table(lyt, ex_adsl)
+
+  main_title(tbl) <- "Main title"
+  subtitles(tbl) <- c("Some Many", "Subtitles")
+  main_footer(tbl) <- c("Some Footer", "Mehr")
+  prov_footer(tbl) <- "Some prov Footer"
+
+  cw <- c(0.9, 0.05, 0.05)
+  spd <- section_properties_default(orientation = "landscape")
+  fin_cw <- cw * spd$page_size$width / 2 / sum(cw)
+
+  # Fixed total width is / 2
+  flx_res <- rtables::tt_to_flextable(tbl,
+    total_page_width = spd$page_size$width / 2,
+    counts_in_newline = TRUE,
+    autofit_to_page = TRUE,
+    bold_titles = TRUE,
+    colwidths = cw
+  ) # if you add cw then autofit_to_page = FALSE
+  dflx <- dim(flx_res) %>% print()
+  testthat::expect_equal(fin_cw, unname(dflx$widths))
 })