Refining split (#19)

Fixes #18 --------- Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
insightsengineering · Nov 22, 2024 · 441c885 · 441c885
1 parent bd9545d
commit 441c885
Show file tree

Hide file tree

Showing 14 changed files with 177 additions and 354 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -59,6 +59,5 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Collate:
     'package.R'
-    'tt_export.R'
-    'tt_as_flextable.R'
-    'tt_to_paginate_office.R'
+    'export_as_docx.R'
+    'as_flextable.R'
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,8 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
 export(export_as_docx)
-export(export_as_pdf)
-export(export_as_txt)
 export(margins_landscape)
 export(margins_potrait)
 export(section_properties_default)
@@ -15,10 +13,6 @@ import(formatters)
 import(methods)
 import(officer)
 import(rtables)
-importFrom(formatters,export_as_pdf)
-importFrom(formatters,export_as_txt)
 importFrom(lifecycle,deprecated)
 importFrom(magrittr,"%>%")
-importFrom(rtables,import_from_tsv)
 importFrom(stats,setNames)
-importFrom(tools,file_ext)
diff --git a/R/tt_as_flextable.R → R/as_flextable.R b/R/tt_as_flextable.R → R/as_flextable.R
@@ -41,7 +41,7 @@
 #' @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()]
+#' @param ... (`any`)\cr additional parameters to be passed to the pagination function. See [rtables::paginate_table()]
 #'   for further details.
 #'
 #' @return A `flextable` object.
@@ -57,9 +57,9 @@
 #' theme like shown in the examples. Please pay attention to the parameters' inputs as they are relevant
 #' for this to work properly.
 #' Indeed, it is possible to use some hidden values for building your own theme (hence the need of `...`).
-#' In particular, `tt_to_flextable` sends in the following variable: `tbl_row_class = make_row_df(tt)$node_class`.
-#' This is ignored if not used in the theme. See `theme_docx_default` for an example on own to retrieve
-#' these values and how to use them.
+#' In particular, `tt_to_flextable` sends in the following variable:
+#' `tbl_row_class = rtables::make_row_df(tt)$node_class`. This is ignored if not used in the theme.
+#' See `theme_docx_default` for an example on own to retrieve these values and how to use them.
 #'
 #' @seealso [export_as_docx()]
 #'
@@ -82,9 +82,6 @@
 #'
 #' tbl <- build_table(lyt, ex_adsl)
 #'
-#' @examples
-#' # example code
-#'
 #' # rtables style
 #' tt_to_flextable(tbl, theme = NULL)
 #'
@@ -116,7 +113,6 @@ tt_to_flextable <- function(tt,
                             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.")
   }
@@ -169,7 +165,7 @@ tt_to_flextable <- function(tt,
         " each table will be too long to fit each page."
       )
     }
-    tabs <- paginate_table(tt,
+    tabs <- rtables::paginate_table(tt,
       fontspec = fontspec,
       lpp = lpp,
       cpp = cpp, tf_wrap = tf_wrap, max_width = max_width, # This can only be trial an error
@@ -193,16 +189,16 @@ tt_to_flextable <- function(tt,
   }
 
   # Extract relevant information
-  matform <- matrix_form(tt, fontspec = fontspec, indent_rownames = FALSE)
-  body <- mf_strings(matform) # Contains header
-  spans <- mf_spans(matform) # Contains header
-  mpf_aligns <- mf_aligns(matform) # Contains header
-  hnum <- mf_nlheader(matform) # Number of lines for the header
-  rdf <- make_row_df(tt) # Row-wise info
+  matform <- rtables::matrix_form(tt, fontspec = fontspec, indent_rownames = FALSE)
+  body <- formatters::mf_strings(matform) # Contains header
+  spans <- formatters::mf_spans(matform) # Contains header
+  mpf_aligns <- formatters::mf_aligns(matform) # Contains header
+  hnum <- formatters::mf_nlheader(matform) # Number of lines for the header
+  rdf <- rtables::make_row_df(tt) # Row-wise info
 
   # decimal alignment pre-proc
   if (any(grepl("dec", mpf_aligns))) {
-    body <- decimal_align(body, mpf_aligns)
+    body <- formatters::decimal_align(body, mpf_aligns)
     # Coercion for flextable
     mpf_aligns[mpf_aligns == "decimal"] <- "center"
     mpf_aligns[mpf_aligns == "dec_left"] <- "left"
@@ -294,7 +290,7 @@ tt_to_flextable <- function(tt,
   # If there are more rows -> add them
   if (hnum > 1) {
     for (i in seq(hnum - 1, 1)) {
-      sel <- spans_to_viscell(spans[i, ])
+      sel <- formatters::spans_to_viscell(spans[i, ])
       flx <- flextable::add_header_row(
         flx,
         top = TRUE,
@@ -364,13 +360,13 @@ tt_to_flextable <- function(tt,
   }
 
   # Footer lines
-  if (length(all_footers(tt)) > 0 && isFALSE(footers_as_text)) {
-    flx <- flextable::add_footer_lines(flx, values = all_footers(tt)) %>%
+  if (length(formatters::all_footers(tt)) > 0 && isFALSE(footers_as_text)) {
+    flx <- flextable::add_footer_lines(flx, values = formatters::all_footers(tt)) %>%
       .add_hborder(part = "body", ii = nrow(tt), border = border)
   }
 
   # Apply the theme
-  flx <- .apply_themes(flx, theme = theme, tbl_row_class = make_row_df(tt)$node_class)
+  flx <- .apply_themes(flx, theme = theme, tbl_row_class = rtables::make_row_df(tt)$node_class)
 
   # lets do some digging into the choice of fonts etc
   if (is.null(fontspec)) {
@@ -379,14 +375,14 @@ tt_to_flextable <- function(tt,
   # Calculate the needed colwidths
   if (is.null(colwidths)) {
     # what about margins?
-    colwidths <- propose_column_widths(matform, fontspec = fontspec, indent_size = indent_size)
+    colwidths <- formatters::propose_column_widths(matform, fontspec = fontspec, indent_size = indent_size)
   }
 
   # Title lines (after theme for problems with lines)
-  if (titles_as_header && length(all_titles(tt)) > 0 && any(nzchar(all_titles(tt)))) {
-    flx <- .add_titles_as_header(flx, all_titles = all_titles(tt), bold = bold_titles) %>%
+  if (titles_as_header && length(formatters::all_titles(tt)) > 0 && any(nzchar(formatters::all_titles(tt)))) {
+    flx <- .add_titles_as_header(flx, all_titles = formatters::all_titles(tt), bold = bold_titles) %>%
       flextable::border(
-        part = "header", i = length(all_titles(tt)),
+        part = "header", i = length(formatters::all_titles(tt)),
         border.bottom = border
       )
   }
@@ -416,8 +412,8 @@ tt_to_flextable <- function(tt,
 # only used in pagination
 .tab_to_colpath_set <- function(tt) {
   vapply(
-    collect_leaves(coltree(tt)),
-    function(y) paste(pos_to_path(rtables:::tree_pos(y)), collapse = " "),
+    rtables::collect_leaves(rtables::coltree(tt)),
+    function(y) paste(rtables:::pos_to_path(rtables:::tree_pos(y)), collapse = " "),
     ""
   )
 }
@@ -477,7 +473,7 @@ tt_to_flextable <- function(tt,
   font_fam <- test_flx$header$styles$text$font.family$data[1, 1]
   font_fam <- "Courier" # Fix if we need it -> coming from gpar and fontfamily Arial not being recognized
 
-  font_spec(font_family = font_fam, font_size = font_sz, lineheight = 1)
+  formatters::font_spec(font_family = font_fam, font_size = font_sz, lineheight = 1)
 }
 
 .apply_alignments <- function(flx, aligns_df, part) {
@@ -569,7 +565,6 @@ theme_docx_default <- function(font = "Arial",
                                bold_manual = NULL,
                                border = flextable::fp_border_default(width = 0.5)) {
   function(flx, ...) {
-    check_required_packages("flextable")
     if (!inherits(flx, "flextable")) {
       stop(sprintf(
         "Function `%s` supports only flextable objects.",
@@ -637,13 +632,13 @@ theme_docx_default <- function(font = "Arial",
     # Content rows are effectively our labels in row names
     if (any(bold == "content_rows")) {
       if (is.null(tbl_row_class)) {
-        stop('bold = "content_rows" needs tbl_row_class = make_row_df(tt).')
+        stop('bold = "content_rows" needs tbl_row_class = rtables::make_row_df(tt).')
       }
       flx <- flextable::bold(flx, j = 1, i = which(tbl_row_class == "ContentRow"), part = "body")
     }
     if (any(bold == "label_rows")) {
       if (is.null(tbl_row_class)) {
-        stop('bold = "content_rows" needs tbl_row_class = make_row_df(tt).')
+        stop('bold = "content_rows" needs tbl_row_class = rtables::make_row_df(tt).')
       }
       flx <- flextable::bold(flx, j = 1, i = which(tbl_row_class == "LabelRow"), part = "body")
     }
@@ -670,7 +665,6 @@ theme_html_default <- function(font = "Courier",
                                remove_internal_borders = "label_rows",
                                border = flextable::fp_border_default(width = 1, color = "black")) {
   function(flx, ...) {
-    check_required_packages("flextable")
     if (!inherits(flx, "flextable")) {
       stop(sprintf(
         "Function `%s` supports only flextable objects.",

diff --git a/R/tt_export.R → R/export_as_docx.R b/R/tt_export.R → R/export_as_docx.R
@@ -1,59 +1,3 @@
-#' @importFrom tools file_ext
-NULL
-
-check_required_packages <- function(pkgs) {
-  for (pkgi in pkgs) {
-    if (!requireNamespace(pkgi, quietly = TRUE)) {
-      stop(
-        "This function requires the ", pkgi, " package. ",
-        "Please install it if you wish to use it"
-      )
-    }
-  }
-}
-
-
-# txt (formatters) --------------------------------------------------------------------
-#' @importFrom formatters export_as_txt
-#'
-#' @examples
-#' lyt <- basic_table() %>%
-#'   split_cols_by("ARM") %>%
-#'   analyze(c("AGE", "BMRKR2", "COUNTRY"))
-#'
-#' tbl <- build_table(lyt, ex_adsl)
-#'
-#' cat(export_as_txt(tbl, file = NULL, paginate = TRUE, lpp = 8))
-#'
-#' \dontrun{
-#' tf <- tempfile(fileext = ".txt")
-#' export_as_txt(tbl, file = tf)
-#' system2("cat", tf)
-#' }
-#'
-#' @export
-formatters::export_as_txt
-
-# pdf (formatters) ----------------------------------------------------------
-#' @importFrom formatters export_as_pdf
-#'
-#' @examples
-#' lyt <- basic_table() %>%
-#'   split_cols_by("ARM") %>%
-#'   analyze(c("AGE", "BMRKR2", "COUNTRY"))
-#'
-#' tbl <- build_table(lyt, ex_adsl)
-#'
-#' \dontrun{
-#' tf <- tempfile(fileext = ".pdf")
-#' export_as_pdf(tbl, file = tf, pg_height = 4)
-#' tf <- tempfile(fileext = ".pdf")
-#' export_as_pdf(tbl, file = tf, lpp = 8)
-#' }
-#'
-#' @export
-formatters::export_as_pdf
-
 # docx (flextable) -----------------------------------------------------------
 #' Export as word document
 #'
@@ -74,7 +18,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()]
@@ -103,7 +47,6 @@ export_as_docx <- function(tt,
                            section_properties = section_properties_default(),
                            ...) {
   # Checks
-  check_required_packages(c("flextable", "officer"))
   if (inherits(tt, "VTableTree")) {
     flex_tbl <- tt_to_flextable(tt,
       titles_as_header = titles_as_header,
@@ -125,8 +68,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
@@ -139,13 +110,26 @@ 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
   if (isFALSE(titles_as_header) && inherits(tt, "VTableTree")) {
-    ts_tbl <- all_titles(tt)
+    ts_tbl <- formatters::all_titles(tt)
     if (length(ts_tbl) > 0) {
       doc <- add_text_par(doc, ts_tbl, fpt)
     }
@@ -158,13 +142,13 @@ export_as_docx <- function(tt,
   if (isTRUE(footers_as_text) && inherits(tt, "VTableTree")) {
     # Adding referential footer line separator if present
     # (this is usually done differently, i.e. inside footnotes)
-    matform <- matrix_form(tt, indent_rownames = TRUE)
+    matform <- rtables::matrix_form(tt, indent_rownames = TRUE)
     if (length(matform$ref_footnotes) > 0) {
       doc <- add_text_par(doc, matform$ref_footnotes, fpt_footer)
     }
     # Footer lines
-    if (length(all_footers(tt)) > 0) {
-      doc <- add_text_par(doc, all_footers(tt), fpt_footer)
+    if (length(formatters::all_footers(tt)) > 0) {
+      doc <- add_text_par(doc, formatters::all_footers(tt), fpt_footer)
     }
   }
 
@@ -175,6 +159,8 @@ export_as_docx <- function(tt,
 
   # Save the Word document to a file
   print(doc, target = file)
+
+  invisible(TRUE)
 }
 
 # Shorthand to add text paragraph

diff --git a/R/package.R b/R/package.R
@@ -7,7 +7,6 @@
 #' @import methods
 #' @import formatters
 #' @import rtables
-#' @importFrom rtables import_from_tsv
 #' @import officer
 #' @import flextable
 NULL
diff --git a/R/tt_to_paginate_office.R b/R/tt_to_paginate_office.R