Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

allow content row in the end #226

Merged
merged 7 commits into from
Jan 4, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
## formatters 0.5.5.9003
* Added "N=xx" format and unit test for it
* Allow tables with content rows in the end be exported.

## formatters 0.5.5
* Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.
Expand Down
12 changes: 6 additions & 6 deletions R/matrix_form.R
Original file line number Diff line number Diff line change
Expand Up @@ -729,10 +729,10 @@ update_mf_ref_nlines <- function(mform, max_width) {
#' @export
#' @rdname mpf_accessors
`mf_cinfo<-` <- function(mf, value) {
if (NROW(value) > 0 && NROW(value) != ncol(mf)) {
if (NROW(value) > 0 && NROW(value) != mf_ncol(mf)) {
stop(
"Number of rows in new cinfo (", NROW(value), ") does not match ",
"number of columns (", ncol(mf), ")"
"number of columns (", mf_ncol(mf), ")"
)
}
mf$col_info <- value
Expand Down Expand Up @@ -805,7 +805,7 @@ mpf_has_rlabels <- function(mf) {

#' @export
#' @rdname mpf_accessors
mf_has_rlabels <- function(mf) ncol(mf$strings) > ncol(mf)
mf_has_rlabels <- function(mf) ncol(mf$strings) > mf_ncol(mf)

#' Create spoof matrix form from a data.frame
#'
Expand Down Expand Up @@ -902,7 +902,7 @@ reconstruct_basic_fnote_list <- function(mf) {
}

.mf_subset_core_mats <- function(mf, i, row = TRUE) {
fillnum <- if (row) nrow(mf_strings(mf)) - mf_nlheader(mf) else ncol(mf)
fillnum <- if (row) nrow(mf_strings(mf)) - mf_nlheader(mf) else mf_ncol(mf)
if (is.logical(i) || all(i < 0)) {
i <- seq_len(fillnum)[i]
}
Expand Down Expand Up @@ -969,7 +969,7 @@ mpf_subset_rows <- function(mf, i) {
nrs <- length(unique(row_lgrps))
ncolrows <- length(unique(lgrps[seq_len(nlh)]))

ncs <- ncol(mf)
ncs <- mf_ncol(mf)
mf <- .mf_subset_core_mats(mf, i, row = TRUE)
map <- data.frame(
old_idx = c(seq_len(ncolrows), i + ncolrows),
Expand Down Expand Up @@ -1004,7 +1004,7 @@ mpf_subset_rows <- function(mf, i) {
## column information that will need to be touched up
## but lets be careful and do a bit more anyway
mpf_subset_cols <- function(mf, j) {
nc <- ncol(mf)
nc <- mf_ncol(mf)
if (is.logical(j) || all(j < 0)) {
j <- seq_len(nc)[j]
}
Expand Down
28 changes: 22 additions & 6 deletions R/pagination.R
Original file line number Diff line number Diff line change
Expand Up @@ -267,10 +267,25 @@ valid_pag <- function(pagdf,
return(FALSE)
}
if (rw[["node_class"]] %in% c("LabelRow", "ContentRow")) {
if (verbose) {
message("\t....................... FAIL: last row is a label or content row")
# check if it has children; if no children then valid
has_children <- rw$abs_rownumber %in% unlist(pagdf$reprint_inds)
if (rw$abs_rownumber == nrow(pagdf)) {
if (verbose) {
message("\t....................... EXCEPTION: last row is a label or content row but in lpp")
}
} else if (!any(has_children)) {
if (verbose) {
message(
"\t....................... EXCEPTION: last row is a label or content row\n",
"but does not have rows and row groups depending on it"
)
}
} else {
if (verbose) {
message("\t....................... FAIL: last row is a label or content row")
}
return(FALSE)
}
return(FALSE)
}

sibpos <- rw[["pos_in_siblings"]]
Expand Down Expand Up @@ -352,7 +367,8 @@ find_pag <- function(pagdf,
guess <- guess - 1
}
if (guess < start) {
if (isFALSE(do_error)) {
# Repeat pagination process to see what went wrong with verbose on
if (isFALSE(do_error) && isFALSE(verbose)) {
find_pag(
pagdf = pagdf,
start = start,
Expand All @@ -364,13 +380,13 @@ find_pag <- function(pagdf,
row = row,
have_col_fnotes = have_col_fnotes,
div_height = div_height,
do_error = TRUE
do_error = TRUE # only used to avoid loop
)
}
stop(
"Unable to find any valid pagination split\ between ",
ifelse(row, "rows ", "columns "), start, " and ", origuess, ". \n",
"Inserted ", ifelse(row, "cpp (column-space, content per page) ", "lpp (row-space, lines per page) "),
"Inserted ", ifelse(row, "lpp (row-space, lines per page) ", "cpp (column-space, content per page) "),
": ", pagdf$par_extent[start] + rlpp, "\n",
"Need-to-repeat-in-each-page space (key values): ", pagdf$par_extent[start], "\n",
"Remaining space: ", rlpp, "\n",
Expand Down
8 changes: 4 additions & 4 deletions tests/testthat/test-pagination.R
Original file line number Diff line number Diff line change
Expand Up @@ -64,14 +64,14 @@ test_that("pagination works", {
## min_siblings = 0,
## verbose = TRUE))

expect_error(
paginate_to_mpfs(
expect_identical(
length(paginate_to_mpfs(
dfmf_cont,
lpp = 8 + 2,
min_siblings = 0,
verbose = TRUE
),
"Unable to find any valid pagination"
)),
7L
)

## https://github.com/insightsengineering/rtables/issues/318
Expand Down