Update paginate_listing algorithm

insightsengineering · Mar 5, 2024 · 6c84b02 · 6c84b02
1 parent 8606752
commit 6c84b02
Showing 1 changed file with 59 additions and 45 deletions.
diff --git 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