Support pagination of lists of rtables/rlistings objects

NEWS.md

@@ -10,6 +10,7 @@
  * Fixed mismatch between pagination and exports regarding the value assigned to parameter `max_width`. Introduced general handler `.handle_max_width` for pagination, exports, and `toString`.
  * Fixed bug in `format_value` causing a warning for vectors containing both NA and non-NA values.
  * Fixed issue with `var_label` assignment that needed to be of non-named strings.
+ * Updated `export_as_txt` to allow lists of tables/listings as input. This enables listing pagination with pages by parameter.
 
 ## formatters 0.5.5
  * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.

R/generics.R

@@ -635,10 +635,21 @@ setMethod("do_forced_paginate", "ANY", function(obj) list(obj))
 #' @examples
 #' mpf <- basic_matrix_form(mtcars)
 #' num_rep_cols(mpf)
+#' lmpf <- basic_listing_mf(mtcars)
+#' num_rep_cols(lmpf)
 setGeneric("num_rep_cols", function(obj) standardGeneric("num_rep_cols"))
 #' @export
 #' @rdname num_rep_cols
 setMethod("num_rep_cols", "ANY", function(obj) 0L)
+#' @export
+#' @rdname num_rep_cols
+setMethod("num_rep_cols", "MatrixPrintForm", function(obj) {
+  if (.is_listing_mf(obj)) {
+    return(length(.get_keycols_from_listing(obj)))
+  } else {
+    return(0L) # same as ANY for non-listing objects
+  }
+})
 
 # header_section_div -----------------------------------------------------------
 #' @keywords internal

R/matrix_form.R

@@ -219,6 +219,8 @@ disp_from_spans <- function(spans) {
 #' @param main_footer character(1). Main footer as a string.
 #' @param prov_footer character. Provenance footer information as a
 #'     character vector.
+#' @param listing_keycols character. If matrix form of a listing, this contains
+#'     the key columns as a character vector.
 #' @param header_section_div character(1). Divider to be used between header
 #'     and body sections.
 #' @param horizontal_sep character(1). Horizontal separator to be used for printing
@@ -286,6 +288,7 @@ MatrixPrintForm <- function(strings = NULL,
                             main_title = "",
                             subtitles = character(),
                             page_titles = character(),
+                            listing_keycols = NULL,
                             main_footer = "",
                             prov_footer = character(),
                             header_section_div = NA_character_,
@@ -315,6 +318,7 @@ MatrixPrintForm <- function(strings = NULL,
       header_section_div = header_section_div,
       horizontal_sep = horizontal_sep,
       col_gap = col_gap,
+      listing_keycols = listing_keycols,
       table_inset = as.integer(table_inset),
       has_topleft = has_topleft,
       indent_size = indent_size,
@@ -915,8 +919,12 @@ basic_matrix_form <- function(df, parent_path = "root", ignore_rownames = FALSE,
     has_topleft = FALSE,
     nlines_header = 1,
     nrow_header = 1,
-    has_rowlabs = TRUE
+    has_rowlabs = isFALSE(ignore_rownames)
   )
+
+  # Check for ncols
+  stopifnot(mf_has_rlabels(ret) == isFALSE(ignore_rownames))
+
   ret <- mform_build_refdf(ret)
 
   if (add_decoration) {
@@ -936,7 +944,6 @@ basic_matrix_form <- function(df, parent_path = "root", ignore_rownames = FALSE,
 #'
 #' @param keycols character. Vector of `df` column names that are printed first and
 #'   repeated values are assigned to `""`. This format is characteristic of a listing matrix form.
-#'   When `NULL`, no key columns are used. Defaults to `c("vs", "gear")` for `mtcars` default dataset.
 #' @return A valid `MatrixPrintForm` object representing `df` as a listing,
 #'   ready for ASCII rendering.
 #'
@@ -946,18 +953,20 @@ basic_matrix_form <- function(df, parent_path = "root", ignore_rownames = FALSE,
 #'
 #' @export
 basic_listing_mf <- function(df,
-                             keycols = c("vs", "gear"),
-                             ignore_rownames = FALSE,
+                             keycols = names(df)[1],
                              add_decoration = TRUE) {
   checkmate::assert_data_frame(df)
   checkmate::assert_subset(keycols, colnames(df))
 
   dfmf <- basic_matrix_form(
     df = df,
-    ignore_rownames = ignore_rownames,
+    ignore_rownames = TRUE,
     add_decoration = add_decoration
   )
 
+  # keycols addition to MatrixPrintForm (should happen in the constructor)
+  dfmf$listing_keycols <- keycols
+
   # Modifications needed for making it a listings
   mf_strings(dfmf)[1, ] <- colnames(mf_strings(dfmf)) # set colnames
 
@@ -994,7 +1003,8 @@ basic_listing_mf <- function(df,
 
   dfmf$aligns[seq(2, nrow(dfmf$aligns)), ] <- "center" # the default for listings
 
-  dfmf$formats[] <- 1 # the default for listings is numeric??
+  # the default for listings is a 1 double??
+  dfmf$formats <- matrix(1, nrow = nrow(dfmf$formats), ncol = ncol(dfmf$formats))
 
   # row info
   ri <- dfmf$row_info
@@ -1003,11 +1013,18 @@ basic_listing_mf <- function(df,
   ri$path <- as.list(NA_character_) # same format of listings
   ri$node_class <- "listing_df"
   # l_ri$pos_in_siblings # why is it like this in rlistings?? also n_siblings
+  class(ri$path) <- "AsIs" # Artifact from I()
   dfmf$row_info <- ri
 
   # colwidths need to be sorted too!!
   dfmf$col_widths <- dfmf$col_widths[colnames(mf_strings(dfmf))]
 
+  if (!add_decoration) {
+    # This is probably a forced behavior in the original matrix_form in rlistings
+    main_title(dfmf) <- character()
+    main_footer(dfmf) <- character()
+  }
+
   dfmf
 }
 
@@ -1046,11 +1063,12 @@ reconstruct_basic_fnote_list <- function(mf) {
 
   tmp_strmat <- mf_strings(mf)[i_mat, j_mat, drop = FALSE]
 
-  # Only for listings
-  if (nrow(tmp_strmat) > 0 && .is_listing(mf)) { # safe check for empty listings
+  # Only for listings - Fix pagination with empty values in key columns
+  if (nrow(tmp_strmat) > 0 && .is_listing_mf(mf)) { # safe check for empty listings
+    ind_keycols <- which(colnames(tmp_strmat) %in% keycols)
 
     # Fix for missing labels in key columns (only for rlistings)
-    empty_keycols <- !nzchar(tmp_strmat[-seq_len(nlh), keycols, drop = FALSE][1, ])
+    empty_keycols <- !nzchar(tmp_strmat[-seq_len(nlh), ind_keycols, drop = FALSE][1, ])
 
     if (any(empty_keycols)) { # only if there are missing keycol labels
       # find the first non-empty label in the key columns
@@ -1085,10 +1103,11 @@ reconstruct_basic_fnote_list <- function(mf) {
   mf_lgrouping(mf) <- as.integer(as.factor(mf_lgrouping(mf)[i_mat]))
 
   if (!row) {
-    newspans <- truncate_spans(mf_spans(mf), j_mat) # 'i' is the columns here, b/c row is FALSE
+    newspans <- truncate_spans(mf_spans(mf), j_mat) # 'i' is the columns here, bc row is FALSE
   } else {
     newspans <- mf_spans(mf)[i_mat, j_mat, drop = FALSE]
   }
+
   mf_spans(mf) <- newspans
   mf_formats(mf) <- mf_formats(mf)[i_mat, j_mat, drop = FALSE]
 

R/mpf_exporters.R

@@ -58,10 +58,20 @@ export_as_txt <- function(x,
                           colwidths = NULL,
                           min_siblings = 2,
                           nosplitin = character(),
-                          rep_cols = num_rep_cols(x),
+                          rep_cols = NULL,
                           verbose = FALSE,
                           page_break = "\\s\\n",
                           page_num = default_page_number()) {
+  # Processing lists of tables or listings
+  if (.is_list_of_tables_or_listings(x)) {
+    if (isFALSE(paginate)) {
+      warning(
+        "paginate is FALSE, but x is a list of tables or listings, ",
+        "so paginate will automatically be updated to TRUE"
+      )
+    }
+    paginate <- TRUE
+  }
 
   if (paginate) {
     pages <- paginate_to_mpfs(
@@ -101,7 +111,7 @@ export_as_txt <- function(x,
     )
   }
 
-  ## we dont' set widths here because we already but that info on mpf
+  ## we don't set widths here because we already put that info in mpf
   ## so its on each of the pages.
   strings <- vapply(
     pages, toString, "",
@@ -118,55 +128,24 @@ export_as_txt <- function(x,
   }
 }
 
+.is_list_of_tables_or_listings <- function(a_list) {
+  all_matrix_forms <- FALSE
+  obj_are_tables_or_listings <- FALSE
 
+  if (is(a_list[[1]], "MatrixPrintForm")) {
+    all_matrix_forms <- all(sapply(a_list, is, class2 = "MatrixPrintForm"))
+  } else {
+    obj_are_tables_or_listings <- all(
+      sapply(a_list, function(list_i) {
+        is(list_i, "listing_df") || is(list_i, "VTableTree")
+      })
+    )
+  }
 
-##     ## TODO this needs to be in terms of a MPF, so ncol(tt) needs to change
-
-##     ## if(!is.null(colwidths) && length(colwidths) != ncol(tt) + 1)
-##     ##     stop("non-null colwidths argument must have length ncol(tt) + 1 [",
-##     ##          ncol(tt) + 1, "], got length ", length(colwidths))
-
-##     mpf <- matrix_form(x, indent_rownames = TRUE)
-
-##     ps_spec <- calc_lcpp(page_type = page_type,
-##                          landscape = landscape,
-##                          pg_width = pg_width,
-##                          pg_height = pg_height,
-##                          font_family = font_family,
-##                          cpp = cpp,
-##                          lpp = lpp)
-
-##     ## This needs to return list(x) in cases where no pagination was necessary
-##     idx_lst <- paginate(mpf, .page_size_spec = ps_spec, colwidths = colwidths,
-##                      tf_wrap = tf_wrap, ## XXX I think we don't need this
-##                      ...)
-
-##     tbls <- lapply(idx_lst, function(ii)
-##     ## XXX how do we partition the colwidths ???
-##     ## Also this is gross make it a function!!!
-##     res <- paste(mapply(function(tb, cwidths, ...) {
-##         ## 1 and +1 are because cwidths includes rowlabel 'column'
-##         cinds <- c(1, .figure_out_colinds(tb, tt) + 1L)
-##         toString(tb, widths = cwidths[cinds], ...)
-##     },
-##     MoreArgs = list(hsep = hsep,
-##                     indent_size = indent_size,
-##                     tf_wrap = tf_wrap,
-##                     max_width = max_width,
-##                     cwidths = colwidths),
-##     SIMPLIFY = FALSE,
-##     tb = tbls),
-##     collapse = page_break)
-
-##     if(!is.null(file))
-##         cat(res, file = file)
-##     else
-##         res
-## }
-
-
-
+  is(a_list, "list") && (obj_are_tables_or_listings || all_matrix_forms)
+}
 
+# RTF support ------------------------------------------------------------------
 ## In use, must be tested
 prep_header_line <- function(mf, i) {
   ret <- mf$strings[i, mf$display[i, , drop = TRUE], drop = TRUE]
@@ -416,7 +395,7 @@ mpf_to_rtf <- function(mpf,
 
 export_as_rtf <- function(x,
                           file = NULL,
-                          colwidths = propose_column_widths(matrix_form(x, TRUE)),
+                          colwidths = NULL,
                           page_type = "letter",
                           pg_width = page_dim(page_type)[if (landscape) 2 else 1],
                           pg_height = page_dim(page_type)[if (landscape) 1 else 2],
@@ -425,27 +404,29 @@ export_as_rtf <- function(x,
                           font_size = 8,
                           font_family = "Courier",
                           ...) {
+  # Processing lists of tables or listings
+  if (.is_list_of_tables_or_listings(x)) {
+    if (isFALSE(paginate)) {
+      warning(
+        "paginate is FALSE, but x is a list of tables or listings, ",
+        "so paginate will automatically be updated to TRUE"
+      )
+    }
+    paginate <- TRUE
+  }
+
   if (!requireNamespace("r2rtf")) {
     stop("RTF export requires the r2rtf package, please install it.")
   }
   if (is.null(names(margins))) {
     names(margins) <- marg_order
   }
 
-  fullmf <- matrix_form(x, indent_rownames = TRUE)
-  req_ncols <- ncol(fullmf) + as.numeric(mf_has_rlabels(fullmf))
-  if (!is.null(colwidths) && length(colwidths) != req_ncols) {
-    stop(
-      "non-null colwidths argument must have length ncol(x) (+ 1 if row labels are present) [",
-      req_ncols, "], got length ", length(colwidths)
-    )
-  }
-
   true_width <- pg_width - sum(margins[c("left", "right")])
   true_height <- pg_height - sum(margins[c("top", "bottom")])
 
   mpfs <- paginate_to_mpfs(
-    fullmf,
+    x,
     font_family = font_family, font_size = font_size,
     pg_width = true_width,
     pg_height = true_height,
@@ -481,6 +462,7 @@ export_as_rtf <- function(x,
 }
 
 
+# PDF support ------------------------------------------------------------------
 #' Export as PDF
 #'
 #' The PDF output is based on the ASCII output created with [toString()]
@@ -543,16 +525,23 @@ export_as_pdf <- function(x,
                           cpp = NULL,
                           hsep = "-",
                           indent_size = 2,
+                          rep_cols = NULL,
                           tf_wrap = TRUE,
                           max_width = NULL,
-                          colwidths = propose_column_widths(x)) {
+                          colwidths = NULL) {
   stopifnot(tools::file_ext(file) != ".pdf")
-  if (!is.null(colwidths) && length(colwidths) != ncol(x) + 1) {
-    stop(
-      "non-null colwidths argument must have length ncol(x) + 1 [",
-      ncol(x) + 1, "], got length ", length(colwidths)
-    )
+
+  # Processing lists of tables or listings
+  if (.is_list_of_tables_or_listings(x)) {
+    if (isFALSE(paginate)) {
+      warning(
+        "paginate is FALSE, but x is a list of tables or listings, ",
+        "so paginate will automatically be updated to TRUE"
+      )
+    }
+    paginate <- TRUE
   }
+
   gp_plot <- grid::gpar(fontsize = font_size, fontfamily = font_family)
 
   if (!is.null(height)) {
@@ -604,7 +593,7 @@ export_as_pdf <- function(x,
       max_width = max_width,
       indent_size = indent_size,
       verbose = FALSE,
-      rep_cols = num_rep_cols(x),
+      rep_cols = rep_cols,
       page_num = page_num
     )
   } else {