Merge a533588 into 0ea3eed

insightsengineering · May 17, 2023 · 6af4174 · 6af4174
2 parents 0ea3eed + a533588
commit 6af4174
Show file tree

Hide file tree

Showing 31 changed files with 648 additions and 728 deletions.
diff --git a/.gitignore b/.gitignore
@@ -32,6 +32,7 @@ complexmodel.R
 dt_573_MHT01_npaszty.Rmd
 
 tests/unit_test_results.xml
+tests/testthat/Rplots.pdf
 
 *.prof
 /doc/

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: rtables
 Title: Reporting Tables
-Version: 0.6.0.3
+Version: 0.6.0.9004
 Date: 2023-05-04
 Authors@R: c(
     person("Gabriel", "Becker", , "gabembecker@gmail.com", role = c("aut", "cre")),
@@ -24,7 +24,7 @@ URL: https://github.com/insightsengineering/rtables,
     https://insightsengineering.github.io/rtables/
 BugReports: https://github.com/insightsengineering/rtables/issues
 Depends: 
-    formatters (>= 0.4.0),
+    formatters (>= 0.4.1.9003),
     magrittr,
     methods,
     R (>= 2.10)
@@ -37,7 +37,6 @@ Suggests:
     flextable,
     knitr,
     officer,
-    r2rtf,
     rmarkdown,
     survival,
     testthat,

diff --git a/NAMESPACE b/NAMESPACE
@@ -2,8 +2,6 @@
 
 S3method(print,CellValue)
 S3method(print,RowsVerticalSection)
-export("[")
-export("[<-")
 export("cell_footnotes<-")
 export("clayout<-")
 export("col_counts<-")
@@ -17,6 +15,7 @@ export("horizontal_sep<-")
 export("indent_mod<-")
 export("label_at_path<-")
 export("ref_index<-")
+export("ref_symbol<-")
 export("row_footnotes<-")
 export("top_left<-")
 export("tree_children<-")
@@ -82,7 +81,6 @@ export(drop_and_remove_levels)
 export(drop_facet_levels)
 export(drop_split_levels)
 export(export_as_pdf)
-export(export_as_rtf)
 export(export_as_tsv)
 export(export_as_txt)
 export(format_rcell)
@@ -121,6 +119,7 @@ export(rbindl_rtables)
 export(rcell)
 export(ref_index)
 export(ref_msg)
+export(ref_symbol)
 export(remove_split_levels)
 export(reorder_split_levels)
 export(rheader)
@@ -200,6 +199,7 @@ exportMethods("obj_na_str<-")
 exportMethods("obj_name<-")
 exportMethods("prov_footer<-")
 exportMethods("ref_index<-")
+exportMethods("ref_symbol<-")
 exportMethods("row_footnotes<-")
 exportMethods("row_values<-")
 exportMethods("subtitles<-")
@@ -244,6 +244,7 @@ exportMethods(rbind)
 exportMethods(rbind2)
 exportMethods(ref_index)
 exportMethods(ref_msg)
+exportMethods(ref_symbol)
 exportMethods(row.names)
 exportMethods(row_cells)
 exportMethods(row_footnotes)
@@ -261,6 +262,7 @@ exportMethods(tt_at_path)
 exportMethods(value_at)
 import(formatters)
 import(methods)
+importFrom(formatters,export_as_txt)
 importFrom(grDevices,dev.off)
 importFrom(grDevices,pdf)
 importFrom(grid,convertHeight)

diff --git a/R/00tabletrees.R b/R/00tabletrees.R
@@ -1601,16 +1601,24 @@ setMethod("length", "CellValue",
           function(x) 1L)
 
 setClass("RefFootnote", representation(value = "character",
-                                       index = "integer"))
+                                       index = "integer",
+                                       symbol = "character"))
 
 
-RefFootnote <- function(note, index = NA_integer_) {
+RefFootnote <- function(note, index = NA_integer_, symbol = NA_character_) {
     if(is(note, "RefFootnote"))
         return(note)
     else if(length(note) == 0)
         return(NULL)
-
-    new("RefFootnote", value = note, index = index)
+    if(length(symbol) != 1L)
+        stop("Referential footnote can only have a single string as its index.",
+             " Got char vector of length ", length(index))
+    if(!is.na(symbol) &&
+       (index == "NA" || grepl("[{}]", index)))
+        stop("The string 'NA' and strings containing '{' or '}' cannot be used as ",
+             "referential footnote index symbols. Got string '", index, "'.")
+
+    new("RefFootnote", value = note, index = index, symbol = symbol)
 }
 
 #' Cell Value constructor

diff --git a/R/index_footnotes.R b/R/index_footnotes.R
@@ -4,7 +4,12 @@
         return(refs)
 
     lapply(refs, function(refi) {
-        ref_index(refi) <- cur_idx_fun()
+        ## these can be symbols, e.g. ^, † now, those are
+        ## special and don't get reindexed cause they're not numbered
+        ## to begin with
+        idx <- ref_index(refi)
+        if(is.na(idx) || !is.na(as.integer(idx)))
+            ref_index(refi) <- cur_idx_fun()
         refi
     })
 }
@@ -18,18 +23,10 @@ setMethod(".idx_helper", "TableRow",
     row_footnotes(tr) <- .reindex_one_pos(row_footnotes(tr),
                                           cur_idx_fun)
 
-    ## if(length(row_footnotes(tr)) > 0) {
-    ##     row_footnotes(tr) <- .reindex_one_pos(row_footnotes(tr),
-    ##                                           cur_idx_fun)
-    ## }
-
-    ## crfs <- cell_footnotes(tr)
-    ## if(length(unlist(crfs)) > 0) {
-
-        cell_footnotes(tr) <- lapply(cell_footnotes(tr), ##crfs,
-                                     .reindex_one_pos,
-                                     cur_idx_fun = cur_idx_fun
-                                     )
+    cell_footnotes(tr) <- lapply(cell_footnotes(tr), ##crfs,
+                                 .reindex_one_pos,
+                                 cur_idx_fun = cur_idx_fun
+                                 )
     tr
 })
 

diff --git a/R/split_funs.R b/R/split_funs.R
@@ -79,7 +79,7 @@ setGeneric(".applysplit_ref_vals",
 #' functions and modify either the incoming data before they are called or
 #' their outputs.
 #'
-#' @seealso [make_split_fun()] for the API for creating custom split functions, 
+#' @seealso [make_split_fun()] for the API for creating custom split functions,
 #' and [split_funcs] for a variety of pre-defined split functions.
 #'
 #' @examples
@@ -310,7 +310,6 @@ do_split <- function(spl,
 
 .apply_split_inner <- function(spl, df, vals = NULL, labels = NULL, trim = FALSE) {
 
-    ## try to calculate values first. Most of the time we can
     if(is.null(vals))
         vals <- .applysplit_rawvals(spl, df)
     extr <- .applysplit_extras(spl, df, vals)
@@ -589,8 +588,6 @@ setMethod(".applysplit_partlabels", "VarLevelSplit",
     if(is.null(labels)) {
         if(varname == vlabelname) {
             labels <- vals
-            ## } else if (is.factor(df[[vlabelname]])) {
-            ##     labels = levels(df[varvec %in% vals, ][[vlabelname]])
         } else {
             labfact <- is.factor(df[[vlabelname]])
             lablevs <- if(labfact) levels(df[[vlabelname]]) else NULL
@@ -650,9 +647,9 @@ make_splvalue_vec <- function(vals, extrs = list(list()), labels = vals) {
 #' @inherit add_overall_level return
 NULL
 
-#' @rdname split_funcs 
+#' @rdname split_funcs
 #' @export
-#' 
+#'
 #' @examples
 #' lyt <- basic_table() %>%
 #'   split_cols_by("ARM") %>%

diff --git a/R/summary.R b/R/summary.R
@@ -36,7 +36,8 @@ row_paths <- function(x) {
 #' @rdname make_col_row_df
 #' @export
 col_paths <- function(x) {
-  stopifnot(is_rtable(x))
+    if(!is(coltree(x), "LayoutColTree"))
+        stop("I don't know how to extract the column paths from an object of class ", class(x))
   make_col_df(x, visible_only = TRUE)$path
 }
 

diff --git a/R/tree_accessors.R b/R/tree_accessors.R
@@ -2413,6 +2413,28 @@ setMethod("ref_index<-", "RefFootnote",
 })
 
 
+#' @export
+#' @rdname ref_fnotes
+setGeneric("ref_symbol", function(obj) standardGeneric("ref_symbol"))
+#' @export
+#' @rdname int_methods
+setMethod("ref_symbol", "RefFootnote",
+          function(obj) obj@symbol)
+
+#' @export
+#' @rdname ref_fnotes
+setGeneric("ref_symbol<-", function(obj, value) standardGeneric("ref_symbol<-"))
+#' @export
+#' @rdname int_methods
+setMethod("ref_symbol<-", "RefFootnote",
+          function(obj, value) {
+    obj@symbol <- value
+    obj
+})
+
+
+
+
 
 
 #' @export