From 53a2e1072e03b3ac261ed02799a58ef2127ba7ca Mon Sep 17 00:00:00 2001 From: shajoezhu Date: Thu, 11 May 2023 21:17:11 +0800 Subject: [PATCH] remove files that are no longer needed --- DESCRIPTION | 3 - NAMESPACE | 14 -- R/paginate_listing.R | 194 ----------------------- R/rlistings-package.R | 3 - man/paginate.Rd | 114 -------------- tests/testthat/test-paginate_listing.R | 204 ------------------------- 6 files changed, 532 deletions(-) delete mode 100644 R/paginate_listing.R delete mode 100644 man/paginate.Rd delete mode 100644 tests/testthat/test-paginate_listing.R diff --git a/DESCRIPTION b/DESCRIPTION index d7586cdc..dbd187f0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,9 +23,6 @@ Depends: methods, tibble Imports: - checkmate, - grDevices, - grid, stats, utils Suggests: diff --git a/NAMESPACE b/NAMESPACE index 42d9c02d..71b984cd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,8 +10,6 @@ export(export_as_txt) export(get_keycols) export(is_keycol) export(listing_dispcols) -export(pag_listing_indices) -export(paginate_listing) exportMethods("[") exportMethods("main_footer<-") exportMethods("main_title<-") @@ -28,18 +26,6 @@ import(formatters) import(methods) import(tibble) importFrom(formatters,export_as_txt) -importFrom(grDevices,dev.off) -importFrom(grDevices,pdf) -importFrom(grid,convertHeight) -importFrom(grid,convertWidth) -importFrom(grid,get.gpar) -importFrom(grid,gpar) -importFrom(grid,grid.draw) -importFrom(grid,grid.newpage) -importFrom(grid,plotViewport) -importFrom(grid,pushViewport) -importFrom(grid,textGrob) -importFrom(grid,unit) importFrom(stats,na.omit) importFrom(utils,head) importFrom(utils,tail) diff --git a/R/paginate_listing.R b/R/paginate_listing.R deleted file mode 100644 index ce8d1668..00000000 --- a/R/paginate_listing.R +++ /dev/null @@ -1,194 +0,0 @@ -#' Paginate listings -#' -#' @description `r lifecycle::badge("experimental")` -#' -#' Pagination of a listing. This can be vertical for long listings with many -#' rows or horizontal if there are many columns. -#' -#' @param lsting listing_df. The listing to paginate. -#' @param lpp numeric(1) or NULL. Number of row lines (not counting titles and -#' footers) to have per page. Standard is `70` while `NULL` disables vertical -#' pagination. -#' @param cpp numeric(1) or NULL. Width (in characters) of the pages for -#' horizontal pagination. `NULL` (the default) indicates no horizontal -#' pagination should be done. -#' @inheritParams formatters::pag_indices_inner -#' @inheritParams formatters::vert_pag_indices -#' @inheritParams formatters::page_lcpp -#' @inheritParams formatters::toString -#' -#' @returns A list of listings' objects that are meant to be on separated pages. -#' For `pag_tt_indices` a list of paginated-groups of row-indices of `lsting`. -#' -#' @rdname paginate -#' -#' @examples -#' dat <- ex_adae -#' lsting <- as_listing(dat[1:25, ], disp_cols = c("USUBJID", "AESOC", "RACE", "AETOXGR", "BMRKR1")) -#' -#' mat <- matrix_form(lsting) -#' -#' cat(toString(mat)) -#' -#' paginate_listing(lsting, lpp = 10) -#' -#' paginate_listing(lsting, cpp = 100, lpp = 40) -#' -#' paginate_listing(lsting, cpp = 80, lpp = 40, verbose = TRUE) -#' @export -#' -#' @return for `paginate_listing` a list containing separate -#' `listing_df` objects for each page, for `pag_listing_indices`, -#' a list of indices in the direction being paginated corresponding -#' to the individual pages in that dimension. -paginate_listing <- function(lsting, - page_type = "letter", - font_family = "Courier", - font_size = 12, - lineheight = 1, - landscape = FALSE, - pg_width = NULL, - pg_height = NULL, - margins = c(top = .5, bottom = .5, left = .75, right = .75), - lpp, - cpp, - colwidths = propose_column_widths(lsting), - tf_wrap = FALSE, - max_width = NULL, - verbose = FALSE) { - checkmate::assert_class(lsting, "listing_df") - checkmate::assert_numeric(colwidths, lower = 0, len = length(listing_dispcols(lsting)), null.ok = TRUE) - checkmate::assert_flag(tf_wrap) - checkmate::assert_count(max_width, null.ok = TRUE) - checkmate::assert_flag(verbose) - - if (missing(lpp) && missing(cpp) && !is.null(page_type) || - (!is.null(pg_width) && !is.null(pg_height))) { - pg_lcpp <- page_lcpp( - page_type = page_type, - landscape = landscape, - font_family = font_family, - font_size = font_size, - lineheight = lineheight, - margins = margins, - pg_width = pg_width, - pg_height = pg_height - ) - if (missing(lpp)) { - lpp <- pg_lcpp$lpp - } - if (missing(cpp)) { - cpp <- pg_lcpp$cpp - } - } else { - if (missing(cpp)) { - cpp <- NULL - } - if (missing(lpp)) { - lpp <- 70 - } - } - - if (is.null(colwidths)) { - colwidths <- propose_column_widths(matrix_form(lsting, indent_rownames = TRUE)) - } - - if (!tf_wrap) { - if (!is.null(max_width)) { - warning("tf_wrap is FALSE - ignoring non-null max_width value.") - } - max_width <- NULL - } else if (is.null(max_width)) { - max_width <- cpp - } else if (identical(max_width, "auto")) { - # this 3 is column separator width. - max_width <- sum(colwidths) + 3 * (length(colwidths) - 1) - } - if (!is.null(cpp) && !is.null(max_width) && max_width > cpp) { - warning("max_width specified is wider than characters per page width (cpp).") - } - - # row-space pagination. - ret <- if (!is.null(lpp)) { - inds <- pag_listing_indices( - lsting = lsting, - lpp = lpp, - colwidths = colwidths, - verbose = verbose, - max_width = max_width - ) - lapply(inds, function(i) lsting[i, ]) - } else { - list(lsting) - } - - # column-space pagination. - if (!is.null(cpp)) { - inds <- vert_pag_indices( - lsting, - cpp = cpp, - colwidths = colwidths, - verbose = verbose, - rep_cols = length(get_keycols(lsting)) - ) - dispcols <- listing_dispcols(lsting) - pag_cols <- lapply(inds, function(i) dispcols[i]) - ret <- lapply( - ret, - function(oneres) { - lapply( - pag_cols, - function(cnames) { - ret <- oneres[, cnames, drop = FALSE] - listing_dispcols(ret) <- cnames - ret - } - ) - } - ) - ret <- unlist(ret, recursive = FALSE) - } - ret -} - -#' @rdname paginate -#' @export -pag_listing_indices <- function(lsting, - lpp = 15, - colwidths = NULL, - max_width = NULL, - verbose = FALSE) { - checkmate::assert_class(lsting, "listing_df") - checkmate::assert_numeric(colwidths, lower = 0, len = length(listing_dispcols(lsting)), null.ok = TRUE) - checkmate::assert_count(max_width, null.ok = TRUE) - checkmate::assert_flag(verbose) - - dheight <- divider_height(lsting) - dcols <- listing_dispcols(lsting) - cinfo_lines <- max( - mapply(nlines, x = var_labels(lsting)[dcols], max_width = colwidths) - ) + dheight - tlines <- if (any(nzchar(all_titles(lsting)))) { - length(all_titles(lsting)) + dheight + 1L - } else { - 0 - } - flines <- length(all_footers(lsting)) - if (flines > 0) { - flines <- flines + dheight + 1L - } - rlpp <- lpp - cinfo_lines - tlines - flines - if (verbose) { - message("Adjusted Lines Per Page: ", rlpp, " (original lpp: ", lpp, ")") - } - - pagdf <- make_row_df(lsting, colwidths) - pag_indices_inner( - pagdf = pagdf, - rlpp = rlpp, - min_siblings = 0, - verbose = verbose, - have_col_fnotes = FALSE, - div_height = dheight - ) -} diff --git a/R/rlistings-package.R b/R/rlistings-package.R index 21474080..60f88b29 100644 --- a/R/rlistings-package.R +++ b/R/rlistings-package.R @@ -5,8 +5,5 @@ #' @import tibble #' @import methods #' @importFrom utils head tail -#' @importFrom grid textGrob grid.newpage pushViewport plotViewport unit grid.draw -#' @importFrom grid convertHeight convertWidth get.gpar gpar -#' @importFrom grDevices dev.off pdf #' @importFrom stats na.omit NULL diff --git a/man/paginate.Rd b/man/paginate.Rd deleted file mode 100644 index 73d1b1a3..00000000 --- a/man/paginate.Rd +++ /dev/null @@ -1,114 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/paginate_listing.R -\name{paginate_listing} -\alias{paginate_listing} -\alias{pag_listing_indices} -\title{Paginate listings} -\usage{ -paginate_listing( - lsting, - page_type = "letter", - font_family = "Courier", - font_size = 12, - lineheight = 1, - landscape = FALSE, - pg_width = NULL, - pg_height = NULL, - margins = c(top = 0.5, bottom = 0.5, left = 0.75, right = 0.75), - lpp, - cpp, - colwidths = propose_column_widths(lsting), - tf_wrap = FALSE, - max_width = NULL, - verbose = FALSE -) - -pag_listing_indices( - lsting, - lpp = 15, - colwidths = NULL, - max_width = NULL, - verbose = FALSE -) -} -\arguments{ -\item{lsting}{listing_df. The listing to paginate.} - -\item{page_type}{character(1). Name of a page type. See -\code{page_types}. Ignored when \code{pg_width} and \code{pg_height} -are set directly.} - -\item{font_family}{character(1). Name of a font family. An error -will be thrown if the family named is not monospaced. Defaults -to Courier.} - -\item{font_size}{numeric(1). Font size, defaults to 12.} - -\item{lineheight}{numeric(1). Line height, defaults to 1.} - -\item{landscape}{logical(1). Should the dimensions of \code{page_type} -be inverted for landscape? Defaults to \code{FALSE}, ignored when -\code{pg_width} and \code{pg_height} are set directly.} - -\item{pg_width}{numeric(1). Page width in inches.} - -\item{pg_height}{numeric(1). Page height in inches.} - -\item{margins}{numeric(4). Named numeric vector containing \code{'bottom'}, -\code{'left'}, \code{'top'}, and \code{'right'} margins in inches. Defaults -to \code{.5} inches for both vertical margins and \code{.75} for both -horizontal margins.} - -\item{lpp}{numeric(1) or NULL. Number of row lines (not counting titles and -footers) to have per page. Standard is \code{70} while \code{NULL} disables vertical -pagination.} - -\item{cpp}{numeric(1) or NULL. Width (in characters) of the pages for -horizontal pagination. \code{NULL} (the default) indicates no horizontal -pagination should be done.} - -\item{colwidths}{numeric vector. Column widths (in characters) for -use with vertical pagination.} - -\item{tf_wrap}{logical(1). Should the texts for title, subtitle, -and footnotes be wrapped?} - -\item{max_width}{integer(1), character(1) or NULL. Width that title -and footer (including footnotes) materials should be -word-wrapped to. If NULL, it is set to the current print width -of the session (\code{getOption("width")}). If set to \code{"auto"}, -the width of the table (plus any table inset) is used. Ignored -completely if \code{tf_wrap} is \code{FALSE}.} - -\item{verbose}{logical(1). Should additional informative messages about the search for -pagination breaks be shown. Defaults to \code{FALSE}.} -} -\value{ -A list of listings' objects that are meant to be on separated pages. -For \code{pag_tt_indices} a list of paginated-groups of row-indices of \code{lsting}. - -for \code{paginate_listing} a list containing separate -\code{listing_df} objects for each page, for \code{pag_listing_indices}, -a list of indices in the direction being paginated corresponding -to the individual pages in that dimension. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - -Pagination of a listing. This can be vertical for long listings with many -rows or horizontal if there are many columns. -} -\examples{ -dat <- ex_adae -lsting <- as_listing(dat[1:25, ], disp_cols = c("USUBJID", "AESOC", "RACE", "AETOXGR", "BMRKR1")) - -mat <- matrix_form(lsting) - -cat(toString(mat)) - -paginate_listing(lsting, lpp = 10) - -paginate_listing(lsting, cpp = 100, lpp = 40) - -paginate_listing(lsting, cpp = 80, lpp = 40, verbose = TRUE) -} diff --git a/tests/testthat/test-paginate_listing.R b/tests/testthat/test-paginate_listing.R deleted file mode 100644 index f7bc70df..00000000 --- a/tests/testthat/test-paginate_listing.R +++ /dev/null @@ -1,204 +0,0 @@ -testthat::test_that("pagination works vertically", { - # pre-processing and ordering - tmp_data <- ex_adae %>% - dplyr::slice(1:30) %>% - dplyr::distinct(USUBJID, AGE, BMRKR1, .keep_all = TRUE) - - lsting <- as_listing(tmp_data, - key_cols = c("USUBJID", "AGE"), - disp_cols = character() - ) %>% - add_listing_col("BMRKR1", format = "xx.x") - - pages_listings <- suppressMessages(paginate_listing(lsting, lpp = 4, verbose = TRUE)) - - page1_result <- toString(matrix_form(pages_listings[[1]]), hsep = "-") - page2_result <- toString(matrix_form(pages_listings[[2]]), hsep = "-") - - page1_expected <- paste0( - "Unique Subject Identifier Age Continous Level Biomarker 1\n", - "-------------------------------------------------------------\n", - "AB12345-BRA-1-id-134 47 6.5 \n", - "AB12345-BRA-1-id-141 35 7.5 \n" - ) - page2_expected <- paste0( - "Unique Subject Identifier Age Continous Level Biomarker 1\n", - "-------------------------------------------------------------\n", - "AB12345-BRA-1-id-236 32 7.7 \n", - "AB12345-BRA-1-id-265 25 10.3 \n" - ) - testthat::expect_equal(page1_result, page1_expected) - - lsting2 <- lsting %>% add_listing_col("BMRKR2") - pages_listings2 <- suppressMessages(paginate_listing(lsting2, lpp = 4, cpp = 70, verbose = TRUE)) - testthat::expect_equal( - toString(matrix_form(pages_listings2[[1]]), hsep = "-"), - page1_expected - ) - testthat::expect_equal(length(pages_listings2), 6L) - page6_expected <- paste0( - "Unique Subject Identifier Age Categorical Level Biomarker 2\n", - "---------------------------------------------------------------\n", - "AB12345-BRA-1-id-42 36 MEDIUM \n", - "AB12345-BRA-1-id-65 25 MEDIUM \n" - ) - testthat::expect_equal( - toString(matrix_form(pages_listings2[[6]]), hsep = "-"), - page6_expected - ) -}) - -testthat::test_that("horizontal pagination with 0 or 1 key column specified works correctly", { - # pre-processing and ordering - tmp_data <- ex_adae %>% - dplyr::slice(1:30) %>% - distinct(USUBJID, AGE, BMRKR1, .keep_all = TRUE) - - lsting <- as_listing(tmp_data, - key_cols = c("USUBJID"), - disp_cols = character() - ) %>% - add_listing_col("AGE") %>% - add_listing_col("BMRKR1", format = "xx.x") %>% - add_listing_col("BMRKR2") - - pages_listings <- suppressMessages(paginate_listing(lsting, cpp = 70, verbose = TRUE)) - pg1_header <- strsplit(toString(matrix_form(pages_listings[[1]]), hsep = "-"), "\n")[[1]][1:2] - pg2_header <- strsplit(toString(matrix_form(pages_listings[[2]]), hsep = "-"), "\n")[[1]][1:2] - pg1_header_expected <- c( - "Unique Subject Identifier Age Continous Level Biomarker 1", - "-------------------------------------------------------------" - ) - pg2_header_expected <- c( - "Unique Subject Identifier Categorical Level Biomarker 2", - "---------------------------------------------------------" - ) - - testthat::expect_equal(pg1_header, pg1_header_expected) - testthat::expect_equal(pg2_header, pg2_header_expected) - testthat::expect_equal(length(pages_listings), 2L) - - lsting2 <- as_listing(tmp_data, - disp_cols = character() - ) %>% - add_listing_col("USUBJID") %>% - add_listing_col("AGE") %>% - add_listing_col("BMRKR1", format = "xx.x") %>% - add_listing_col("BMRKR2") - - pages_listings2 <- paginate_listing(lsting2, cpp = 70) - pg1_header2 <- strsplit(toString(matrix_form(pages_listings2[[1]]), hsep = "-"), "\n")[[1]][1:2] - pg2_header2 <- strsplit(toString(matrix_form(pages_listings2[[2]]), hsep = "-"), "\n")[[1]][1:2] - pg3_header2 <- strsplit(toString(matrix_form(pages_listings2[[3]]), hsep = "-"), "\n")[[1]][1:2] - - pg1_header2_expected <- c( - "Study Identifier Unique Subject Identifier Age", - "--------------------------------------------------" - ) - pg2_header2_expected <- c( - "Study Identifier Continous Level Biomarker 1", - "----------------------------------------------" - ) - pg3_header2_expected <- c( - "Study Identifier Categorical Level Biomarker 2", - "------------------------------------------------" - ) - - testthat::expect_equal(pg1_header2, pg1_header2_expected) - testthat::expect_equal(pg2_header2, pg2_header2_expected) - testthat::expect_equal(pg3_header2, pg3_header2_expected) - testthat::expect_equal(length(pages_listings2), 3L) -}) - -testthat::test_that("listing works with no vertical pagination", { - # pre-processing and ordering - tmp_data <- ex_adae %>% - dplyr::slice(1:30) %>% - dplyr::distinct(USUBJID, AGE, BMRKR1, .keep_all = TRUE) - - lsting <- as_listing(tmp_data, - key_cols = c("USUBJID", "AGE"), - disp_cols = character() - ) %>% - add_listing_col("BMRKR1", format = "xx.x") - - pages_listings <- paginate_listing(lsting, lpp = NULL) - page1_result <- matrix_form(pages_listings[[1]]) - - testthat::expect_equal(length(pages_listings), 1) - testthat::expect_equal(ncol(page1_result$spans), 3) - testthat::expect_equal(nrow(page1_result$strings), 7) -}) - -testthat::test_that("checking vertical pagination line calculation.", { - # pre-processing and ordering - tmp_data <- ex_adae %>% - dplyr::slice(1:30) %>% - dplyr::distinct(USUBJID, AGE, BMRKR1, .keep_all = TRUE) - - lsting <- as_listing(tmp_data, - key_cols = c("USUBJID", "AGE"), - disp_cols = character(), - main_footer = c("Main Footer A") - ) %>% - add_listing_col("BMRKR1", format = "xx.x") - - pages_listings <- paginate_listing(lsting, lpp = 8) - - # there is always a gap between the end of the table and the footer. Line calculation is correct given this behavior - page1_result <- matrix_form(pages_listings[[1]]) - page2_result <- matrix_form(pages_listings[[2]]) - - testthat::expect_equal(sum(nrow(page1_result$strings), length(page1_result$main_footer)), 5) - testthat::expect_equal(sum(nrow(page2_result$strings), length(page2_result$main_footer)), 5) -}) - -testthat::test_that("pagination: lpp and cpp correctly computed for pg_width and pg_height", { - lsting <- h_lsting_adae() - pag <- paginate_listing(lsting, lpp = 24, cpp = 135) - res <- paginate_listing(lsting, pg_width = 15, pg_height = 5) - testthat::expect_identical(res, pag) -}) - -testthat::test_that("pagination: lpp and cpp correctly computed for page_type and font_size", { - lsting <- h_lsting_adae() - pag1 <- paginate_listing(lsting, lpp = 69, cpp = 73) - res1 <- paginate_listing(lsting, page_type = "a4", font_size = 11) - testthat::expect_identical(res1, pag1) - - pag2 <- paginate_listing(lsting, lpp = 85, cpp = 76) - res2 <- paginate_listing(lsting, page_type = "legal", font_size = 11) - testthat::expect_identical(res2, pag2) -}) - -testthat::test_that("pagination: lpp and cpp correctly computed for lineheight", { - lsting <- h_lsting_adae() - pag <- paginate_listing(lsting, lpp = 20, cpp = 70) - res <- paginate_listing(lsting, lineheight = 3) - testthat::expect_identical(res, pag) -}) - -testthat::test_that("pagination: lpp and cpp correctly computed for landscape", { - lsting <- h_lsting_adae() - pag <- paginate_listing(lsting, lpp = 45, cpp = 95) - res <- paginate_listing(lsting, landscape = TRUE) - testthat::expect_identical(res, pag) -}) - -testthat::test_that("pagination: lpp and cpp correctly computed for margins", { - lsting <- h_lsting_adae() - pag <- paginate_listing(lsting, lpp = 42, cpp = 65) - res <- paginate_listing(lsting, margins = c(top = 2, bottom = 2, left = 1, right = 1)) - testthat::expect_identical(res, pag) -}) - - -testthat::test_that("pagination works with col wrapping", { - lsting <- h_lsting_adae(disp_cols = c("USUBJID", "AESOC", "RACE")) - - testthat::expect_silent(pag <- paginate_listing(lsting, colwidths = c(15, 15, 15, 15))) - pag_no_wrapping <- paginate_listing(lsting) - - testthat::expect_equal(length(pag), length(pag_no_wrapping) + 1) - testthat::expect_error(paginate_listing(lsting, colwidths = c(12, 15))) -})