From 6c84b02f4fbae7c4292719282202eaf4faaab127 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 5 Mar 2024 17:08:52 -0500 Subject: [PATCH] Update paginate_listing algorithm --- R/paginate_listing.R | 104 ++++++++++++++++++++++++------------------- 1 file changed, 59 insertions(+), 45 deletions(-) diff --git a/R/paginate_listing.R b/R/paginate_listing.R index 513a58f0..7b200d3c 100644 --- a/R/paginate_listing.R +++ b/R/paginate_listing.R @@ -56,60 +56,74 @@ paginate_listing <- function(lsting, tf_wrap = !is.null(max_width), max_width = NULL, verbose = FALSE) { - do_full_pag <- function(lsting) { - checkmate::assert_class(lsting, "listing_df") - checkmate::assert_numeric(colwidths, lower = 0, len = length(listing_dispcols(lsting)), null.ok = TRUE) + if (!is(lsting, "listing_df")) { + # process lists of listings + checkmate::assert_true(all(unlist(lapply(lsting, is, "listing_df")))) + if (!"colwidths" %in% as.list(match.call())) { + all_colwidths <- lapply(lsting, propose_column_widths) + max_w <- which.max(lapply(all_colwidths, sum)) + colwidths <- all_colwidths[[max_w]] + } + checkmate::assert_numeric(colwidths, lower = 0, len = length(listing_dispcols(lsting[[1]])), null.ok = TRUE) + lsting_list <- lapply( + lsting, paginate_listing, page_type = page_type, font_family = font_family, font_size = font_size, + lineheight = lineheight, landscape = landscape, pg_width = pg_width, pg_height = pg_height, margins = margins, + lpp = lpp, cpp = cpp, colwidths = colwidths, tf_wrap = tf_wrap, max_width = max_width, verbose = verbose + ) + + ret <- unlist(lsting_list, recursive = FALSE) + ret + } else { checkmate::assert_flag(tf_wrap) checkmate::assert_count(max_width, null.ok = TRUE) checkmate::assert_flag(verbose) + checkmate::assert_class(lsting, "listing_df") + checkmate::assert_numeric(colwidths, lower = 0, len = length(listing_dispcols(lsting)), null.ok = TRUE) indx <- paginate_indices(lsting, - page_type = page_type, - font_family = font_family, - font_size = font_size, - lineheight = lineheight, - landscape = landscape, - pg_width = pg_width, - pg_height = pg_height, - margins = margins, - lpp = lpp, - cpp = cpp, - colwidths = colwidths, - tf_wrap = tf_wrap, - max_width = max_width, - rep_cols = length(get_keycols(lsting)), - verbose = verbose) + page_type = page_type, + font_family = font_family, + font_size = font_size, + lineheight = lineheight, + landscape = landscape, + pg_width = pg_width, + pg_height = pg_height, + margins = margins, + lpp = lpp, + cpp = cpp, + colwidths = colwidths, + tf_wrap = tf_wrap, + max_width = max_width, + rep_cols = length(get_keycols(lsting)), + verbose = verbose + ) - vert_pags <- lapply(indx$pag_row_indices, function(ii) lsting[ii, ]) + vert_pags <- lapply( + indx$pag_row_indices, + function(ii) lsting[ii, ] + ) dispnames <- listing_dispcols(lsting) + full_pag <- lapply( + vert_pags, + function(onepag) { + if (!is.null(indx$pag_col_indices)) { + lapply( + indx$pag_col_indices, + function(jj) { + res <- onepag[, dispnames[jj], drop = FALSE] + listing_dispcols(res) <- intersect(dispnames, names(res)) + res + } + ) + } else { + list(onepag) + } + } + ) - lapply(vert_pags, - function(onepag) { - if (!is.null(indx$pag_col_indices)) { - lapply(indx$pag_col_indices, function(jj) { - res <- onepag[, dispnames[jj], drop = FALSE] - listing_dispcols(res) <- intersect(dispnames, names(res)) - res - }) - } else { - list(onepag) - } - }) - } - - full_pag <- if (is(lsting, "listing_df")) { - do_full_pag(lsting) - } else { - if (!"colwidths" %in% as.list(match.call())) { - all_colwidths <- lapply(lsting, propose_column_widths) - max_w <- which.max(lapply(all_colwidths, sum)) - colwidths <- all_colwidths[[max_w]] - } - lapply(lsting, function(x) unlist(do_full_pag(x), recursive = FALSE)) + ret <- unlist(full_pag, recursive = FALSE) + ret } - - ret <- unlist(full_pag, recursive = FALSE, use.names = FALSE) - ret } #' @title Defunct functions