Merge branch 'main' into 761_better_getter_seeters@221_fix_separator_…

…div@main
insightsengineering · Nov 23, 2023 · 95b7b82 · 95b7b82
2 parents 3324c1b + 3de3da7
commit 95b7b82
Show file tree

Hide file tree

Showing 14 changed files with 192 additions and 43 deletions.
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -2,7 +2,7 @@
 # R specific hooks: https://github.com/lorenzwalthert/precommit
 repos:
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9025
+    rev: v0.3.2.9027
     hooks: 
     -   id: roxygenize
         # roxygen requires loading pkg -> add dependencies from DESCRIPTION

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rtables
 Title: Reporting Tables
-Version: 0.6.5.9012
-Date: 2023-11-16
+Version: 0.6.5.9013
+Date: 2023-11-23
 Authors@R: c(
     person("Gabriel", "Becker", , "[email protected]", role = "aut",
            comment = "Original creator of the package"),
@@ -29,7 +29,7 @@ URL: https://github.com/insightsengineering/rtables,
     https://insightsengineering.github.io/rtables/
 BugReports: https://github.com/insightsengineering/rtables/issues
 Depends:
-    formatters (>= 0.5.4),
+    formatters (>= 0.5.4.9003),
     magrittr (>= 1.5),
     methods,
     R (>= 2.10)

diff --git a/NAMESPACE b/NAMESPACE
@@ -6,6 +6,7 @@ export("cell_footnotes<-")
 export("clayout<-")
 export("col_counts<-")
 export("col_fnotes_here<-")
+export("col_footnotes<-")
 export("col_info<-")
 export("col_total<-")
 export("colcount_format<-")
@@ -66,6 +67,7 @@ export(clear_indent_mods)
 export(col_counts)
 export(col_exprs)
 export(col_fnotes_here)
+export(col_footnotes)
 export(col_info)
 export(col_paths)
 export(col_paths_summary)
@@ -202,6 +204,7 @@ exportMethods("cell_footnotes<-")
 exportMethods("clayout<-")
 exportMethods("col_counts<-")
 exportMethods("col_fnotes_here<-")
+exportMethods("col_footnotes<-")
 exportMethods("col_info<-")
 exportMethods("col_total<-")
 exportMethods("colcount_format<-")
@@ -232,6 +235,7 @@ exportMethods(clayout)
 exportMethods(clear_indent_mods)
 exportMethods(col_counts)
 exportMethods(col_fnotes_here)
+exportMethods(col_footnotes)
 exportMethods(col_info)
 exportMethods(col_total)
 exportMethods(colcount_format)

diff --git a/NEWS.md b/NEWS.md
@@ -1,13 +1,14 @@
-## rtables 0.6.5.9011
+## rtables 0.6.5.9013
 ### New Features
  * Removed `ref_group` reordering in column splits so not to change the order.
  * Added `bold` argument to `as_html` to bold specified elements, and `header_sep_line` 
-   argument to print a    horizontal line under the table header in rendered HTML output.
- * Section divisors can be set also for analysis rows.
- * Added setter and getter for section dividers (`section_div` and `section_div<-`). They accept also
+   argument to print a horizontal line under the table header in rendered HTML output.
+ * Duplicate referential footnotes are consolidated when tables are rendered.
+ * Section divisors can be set for analysis rows.
+ * Added setter and getter for section dividers (`section_div` and `section_div<-`). They also accept
    split section structure assignment.
  * Added `header_section_div` setters and getters for layout and table objects along with 
-   related`basic_table` parameter.
+   related `basic_table` parameter.
 
 ### Bug Fixes
  * Fixed a bug that was failing when wrapping and section dividers were used at the same time.
@@ -16,7 +17,8 @@
  * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.
  * Added Developer Guide to pkgdown site with Debugging, Split Machinery, and Tabulation sections.
  * Whitespace is not trimmed when rendering tables with `as_html`.
- * Exported `section_div` methods have now a dedicated documentation page that is visible to users.
+ * Started deprecation cycle for `col_fnotes_here` to be replaced with `col_footnotes`.
+ * Exported `section_div` methods now have a dedicated documentation page that is visible to users.
 
 ## rtables 0.6.5
 ### New Features

diff --git a/R/index_footnotes.R b/R/index_footnotes.R
@@ -9,7 +9,7 @@
     ## to begin with
     idx <- ref_index(refi)
     if (is.na(idx) || !is.na(as.integer(idx))) {
-      ref_index(refi) <- cur_idx_fun()
+      ref_index(refi) <- cur_idx_fun(refi)
     }
     refi
   })
@@ -63,8 +63,8 @@ index_col_refs <- function(tt, cur_idx_fun) {
 
 
 .index_col_refs_inner <- function(ctree, cur_idx_fun) {
-  col_fnotes_here(ctree) <- .reindex_one_pos(
-    col_fnotes_here(ctree),
+  col_footnotes(ctree) <- .reindex_one_pos(
+    col_footnotes(ctree),
     cur_idx_fun
   )
 
@@ -75,9 +75,9 @@ index_col_refs <- function(tt, cur_idx_fun) {
     )
   }
   ctree
-  ## cfs <- col_fnotes_here(ctree)
+  ## cfs <- col_footnotes(ctree)
   ## if(length(unlist(cfs)) > 0) {
-  ##     col_fnotes_here(ctree) <- .reindex_one_pos(lapply(cfs,
+  ##     col_footnotes(ctree) <- .reindex_one_pos(lapply(cfs,
   ##                                      function(refs) lapply(refs, function(refi) {
 }
 
@@ -95,11 +95,17 @@ index_col_refs <- function(tt, cur_idx_fun) {
 #' manually.
 #' @export
 update_ref_indexing <- function(tt) {
-  curind <- 0L
-  cur_index <- function() {
-    curind <<- curind + 1L
-    curind
+  col_fnotes <- c(list(row_fnotes = list()), col_footnotes(tt))
+  row_fnotes <- row_footnotes(tt)
+  cell_fnotes <- cell_footnotes(tt)
+  all_fns <- rbind(col_fnotes, cbind(row_fnotes, cell_fnotes))
+  all_fns <- unlist(t(all_fns))
+  unique_fnotes <- unique(sapply(all_fns, ref_msg))
+
+  cur_index <- function(ref_fn) {
+    match(ref_msg(ref_fn), unique_fnotes)
   }
+
   if (ncol(tt) > 0) {
     tt <- index_col_refs(tt, cur_index)
   } ## col_info(tt) <- index_col_refs(col_info(tt), cur_index)

diff --git a/R/tree_accessors.R b/R/tree_accessors.R
@@ -2877,33 +2877,83 @@ setMethod("cell_footnotes<-", "ContentRow",
   definition = .cfn_set_helper
 )
 
+# Deprecated methods
 #' @export
 #' @rdname ref_fnotes
 setGeneric("col_fnotes_here", function(obj) standardGeneric("col_fnotes_here"))
 #' @export
+#' @rdname ref_fnotes
+setMethod("col_fnotes_here", "ANY", function(obj) {
+  .Deprecated(
+    new = "col_footnotes",
+    old = "col_fnotes_here",
+    msg = "col_fnotes_here was deprecated in {rtables} version 0.6.5.9011. Please use col_footnotes instead."
+  )
+  col_footnotes(obj)
+})
+#' @export
+#' @rdname ref_fnotes
+setGeneric("col_fnotes_here<-", function(obj, value) standardGeneric("col_fnotes_here<-"))
+#' @export
 #' @rdname int_methods
-setMethod("col_fnotes_here", c("LayoutColTree"), function(obj) obj@col_footnotes)
+setMethod("col_fnotes_here<-", "ANY", function(obj, value) {
+  .Deprecated(
+    new = "col_footnotes<-",
+    old = "col_fnotes_here<-",
+    msg = "col_fnotes_here<- was deprecated in {rtables} version 0.6.5.9011. Please use col_footnotes<- instead."
+  )
+  col_footnotes(obj) <- value
+})
+
+#' @export
+#' @rdname ref_fnotes
+setGeneric("col_footnotes", function(obj) standardGeneric("col_footnotes"))
+
 #' @export
 #' @rdname int_methods
-setMethod("col_fnotes_here", c("LayoutColLeaf"), function(obj) obj@col_footnotes)
+setMethod("col_footnotes", "LayoutColTree", function(obj) obj@col_footnotes)
+
+#' @export
+#' @rdname int_methods
+setMethod("col_footnotes", "LayoutColLeaf", function(obj) obj@col_footnotes)
 
 #' @export
 #' @rdname ref_fnotes
-setGeneric("col_fnotes_here<-", function(obj, value) standardGeneric("col_fnotes_here<-"))
+setGeneric("col_footnotes<-", function(obj, value) standardGeneric("col_footnotes<-"))
+
 #' @export
 #' @rdname int_methods
-setMethod("col_fnotes_here<-", "LayoutColTree", function(obj, value) {
+setMethod("col_footnotes<-", "LayoutColTree", function(obj, value) {
   obj@col_footnotes <- make_ref_value(value)
   obj
 })
 
 #' @export
 #' @rdname int_methods
-setMethod("col_fnotes_here<-", "LayoutColLeaf", function(obj, value) {
+setMethod("col_footnotes<-", "LayoutColLeaf", function(obj, value) {
   obj@col_footnotes <- make_ref_value(value)
   obj
 })
 
+#' @export
+#' @rdname int_methods
+setMethod(
+  "col_footnotes", "VTableTree",
+  function(obj) {
+    ctree <- coltree(obj)
+    cols <- tree_children(ctree)
+    while (all(sapply(cols, is, "LayoutColTree"))) {
+      cols <- lapply(cols, tree_children)
+      cols <- unlist(cols, recursive = FALSE)
+    }
+    all_col_fnotes <- lapply(cols, col_footnotes)
+    if (is.null(unlist(all_col_fnotes))) {
+      return(NULL)
+    }
+
+    return(all_col_fnotes)
+  }
+)
 
 #' @export
 #' @rdname ref_fnotes

diff --git a/R/tt_paginate.R b/R/tt_paginate.R
@@ -447,7 +447,7 @@ setMethod(
       sibpos = sibpos,
       nsibs = nsibs,
       leaf_indices = colnum,
-      col_fnotes = col_fnotes_here(ct)
+      col_fnotes = col_footnotes(ct)
     ))
   }
 )
@@ -487,7 +487,7 @@ setMethod(
           sibpos = sibpos,
           nsibs = nsibs,
           pth = thispth,
-          col_fnotes = col_fnotes_here(ct)
+          col_fnotes = col_footnotes(ct)
         ))
         ret <- c(thisone, ret)
       }

diff --git a/R/tt_pos_and_access.R b/R/tt_pos_and_access.R
@@ -96,7 +96,7 @@ coltree_split <- function(ctree) ctree@split
 
 col_fnotes_at_path <- function(ctree, path, fnotes) {
   if (length(path) == 0) {
-    col_fnotes_here(ctree) <- fnotes
+    col_footnotes(ctree) <- fnotes
     return(ctree)
   }
 

diff --git a/R/tt_toString.R b/R/tt_toString.R
@@ -436,13 +436,12 @@ get_formatted_fnotes <- function(tt) {
   )
 
   inds <- vapply(lst, ref_index, 1L)
-  stopifnot(all(is.na(inds)) || !is.unsorted(inds))
+  ord <- order(inds)
+  lst <- lst[ord]
   syms <- vapply(lst, ref_symbol, "")
   keep <- is.na(syms) | !duplicated(syms)
-  inds <- inds[keep]
   lst <- lst[keep]
-  syms <- syms[keep]
-  vapply(lst, format_fnote_note, "")
+  unique(vapply(lst, format_fnote_note, ""))
 
 
 

diff --git a/man/int_methods.Rd b/man/int_methods.Rd
diff --git a/man/ref_fnotes.Rd b/man/ref_fnotes.Rd
diff --git a/tests/testthat/test-exporters.R b/tests/testthat/test-exporters.R
@@ -333,7 +333,7 @@ test_that("Can create flextable object that works with different styles", {
   expect_equal(sum(unlist(nrow(ft))), 20)
 
   ft2 <- tt_to_flextable(tbl, paginate = TRUE, lpp = 20, verbose = TRUE)
-  expect_equal(length(ft2), 6)
+  expect_equal(length(ft2), 2)
 
   expect_silent(ft3 <- tt_to_flextable(tbl, theme = NULL))