From a1bb3ab6ea74d6153a2bf0bbc510118312e8177c Mon Sep 17 00:00:00 2001 From: Melkiades Date: Wed, 20 Nov 2024 16:43:54 +0100 Subject: [PATCH] refining split --- DESCRIPTION | 5 +- NAMESPACE | 8 -- R/{tt_as_flextable.R => as_flextable.R} | 35 +++-- R/{tt_export.R => export_as_docx.R} | 108 +++++++-------- R/package.R | 3 - R/tt_to_paginate_office.R | 17 --- man/export_as_docx.Rd | 4 +- man/reexports.Rd | 46 ------- man/tt_to_flextable.Rd | 15 +- tests/testthat/Rplots.pdf | Bin 3830 -> 0 bytes tests/testthat/setup.R | 37 ----- ...-tt_as_flextable.R => test-as_flextable.R} | 46 +++++-- tests/testthat/test-export_as_docx.R | 59 ++++++++ tests/testthat/test-exporters.R | 129 ------------------ 14 files changed, 175 insertions(+), 337 deletions(-) rename R/{tt_as_flextable.R => as_flextable.R} (98%) rename R/{tt_export.R => export_as_docx.R} (78%) delete mode 100644 R/tt_to_paginate_office.R delete mode 100644 man/reexports.Rd rename tests/testthat/{test-tt_as_flextable.R => test-as_flextable.R} (77%) create mode 100644 tests/testthat/test-export_as_docx.R delete mode 100644 tests/testthat/test-exporters.R diff --git a/DESCRIPTION b/DESCRIPTION index 786da41..662ab91 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -59,6 +59,5 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Collate: 'package.R' - 'tt_export.R' - 'tt_as_flextable.R' - 'tt_to_paginate_office.R' + 'export_as_docx.R' + 'as_flextable.R' diff --git a/NAMESPACE b/NAMESPACE index 6b59516..7f0f1e8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,8 +1,6 @@ # Generated by roxygen2: do not edit by hand export(export_as_docx) -export(export_as_pdf) -export(export_as_txt) export(margins_landscape) export(margins_potrait) export(section_properties_default) @@ -11,14 +9,8 @@ export(theme_html_default) export(tt_to_flextable) export(word_mm_to_pt) import(flextable) -import(formatters) import(methods) import(officer) -import(rtables) -importFrom(formatters,export_as_pdf) -importFrom(formatters,export_as_txt) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") -importFrom(rtables,import_from_tsv) importFrom(stats,setNames) -importFrom(tools,file_ext) diff --git a/R/tt_as_flextable.R b/R/as_flextable.R similarity index 98% rename from R/tt_as_flextable.R rename to R/as_flextable.R index 2b9581d..d4e3dbd 100644 --- a/R/tt_as_flextable.R +++ b/R/as_flextable.R @@ -1,3 +1,22 @@ +# Helper function for position to path +pos_to_path <- function(pos) { + spls <- rtables:::pos_splits(pos) + vals <- rtables:::pos_splvals(pos) + + path <- character() + for (i in seq_along(spls)) { + nm <- obj_name(spls[[i]]) + val_i <- value_names(vals[[i]]) + path <- c( + path, + obj_name(spls[[i]]), + ## rawvalues(vals[[i]])) + if (!is.na(val_i)) val_i + ) + } + path +} + # Flextable conversion --------------------------------------------------------- # @@ -82,9 +101,6 @@ #' #' tbl <- build_table(lyt, ex_adsl) #' -#' @examples -#' # example code -#' #' # rtables style #' tt_to_flextable(tbl, theme = NULL) #' @@ -92,7 +108,7 @@ #' #' # Example with multiple themes (only extending the docx default!) #' my_theme <- function(x, ...) { -#' flextable::border_inner(x, part = "body", border = flextable::fp_border_default(width = 0.5)) +#' border_inner(x, part = "body", border = flextable::fp_border_default(width = 0.5)) #' } #' flx <- tt_to_flextable(tbl, theme = c(theme_docx_default(), my_theme)) #' @@ -116,7 +132,6 @@ tt_to_flextable <- function(tt, total_page_height = 10, # portrait 11 landscape 8.5 total_page_width = 10, # portrait 8.5 landscape 11 autofit_to_page = TRUE) { - check_required_packages("flextable") if (!inherits(tt, "VTableTree")) { stop("Input table is not an rtables' object.") } @@ -521,7 +536,8 @@ tt_to_flextable <- function(tt, #' #' @seealso [export_as_docx()] #' -#' @examples +#' @examplesIf require(flextable) +#' library(flextable) #' # Custom theme #' special_bold <- list( #' "header" = list("i" = 1, "j" = c(1, 3)), @@ -546,10 +562,7 @@ tt_to_flextable <- function(tt, #' flx <- theme_docx_default(font_size = font_size)(flx, ...) #' #' # Then apply additional styling -#' flx <- flextable::border_inner(flx, -#' part = "body", -#' border = flextable::fp_border_default(width = 0.5) -#' ) +#' flx <- border_inner(flx, part = "body", border = flextable::fp_border_default(width = 0.5)) #' #' return(flx) #' } @@ -569,7 +582,6 @@ theme_docx_default <- function(font = "Arial", bold_manual = NULL, border = flextable::fp_border_default(width = 0.5)) { function(flx, ...) { - check_required_packages("flextable") if (!inherits(flx, "flextable")) { stop(sprintf( "Function `%s` supports only flextable objects.", @@ -670,7 +682,6 @@ theme_html_default <- function(font = "Courier", remove_internal_borders = "label_rows", border = flextable::fp_border_default(width = 1, color = "black")) { function(flx, ...) { - check_required_packages("flextable") if (!inherits(flx, "flextable")) { stop(sprintf( "Function `%s` supports only flextable objects.", diff --git a/R/tt_export.R b/R/export_as_docx.R similarity index 78% rename from R/tt_export.R rename to R/export_as_docx.R index 8cd4cbc..206c70c 100644 --- a/R/tt_export.R +++ b/R/export_as_docx.R @@ -1,59 +1,3 @@ -#' @importFrom tools file_ext -NULL - -check_required_packages <- function(pkgs) { - for (pkgi in pkgs) { - if (!requireNamespace(pkgi, quietly = TRUE)) { - stop( - "This function requires the ", pkgi, " package. ", - "Please install it if you wish to use it" - ) - } - } -} - - -# txt (formatters) -------------------------------------------------------------------- -#' @importFrom formatters export_as_txt -#' -#' @examples -#' lyt <- basic_table() %>% -#' split_cols_by("ARM") %>% -#' analyze(c("AGE", "BMRKR2", "COUNTRY")) -#' -#' tbl <- build_table(lyt, ex_adsl) -#' -#' cat(export_as_txt(tbl, file = NULL, paginate = TRUE, lpp = 8)) -#' -#' \dontrun{ -#' tf <- tempfile(fileext = ".txt") -#' export_as_txt(tbl, file = tf) -#' system2("cat", tf) -#' } -#' -#' @export -formatters::export_as_txt - -# pdf (formatters) ---------------------------------------------------------- -#' @importFrom formatters export_as_pdf -#' -#' @examples -#' lyt <- basic_table() %>% -#' split_cols_by("ARM") %>% -#' analyze(c("AGE", "BMRKR2", "COUNTRY")) -#' -#' tbl <- build_table(lyt, ex_adsl) -#' -#' \dontrun{ -#' tf <- tempfile(fileext = ".pdf") -#' export_as_pdf(tbl, file = tf, pg_height = 4) -#' tf <- tempfile(fileext = ".pdf") -#' export_as_pdf(tbl, file = tf, lpp = 8) -#' } -#' -#' @export -formatters::export_as_pdf - # docx (flextable) ----------------------------------------------------------- #' Export as word document #' @@ -74,7 +18,7 @@ formatters::export_as_pdf #' @param ... (`any`)\cr additional arguments passed to [tt_to_flextable()]. #' #' @note `export_as_docx()` has few customization options available. If you require specific formats and details, -#' we suggest that you use [tt_to_flextable()] prior to `export_as_docx`. Only the `title_as_header` and +#' we suggest that you use [tt_to_flextable()] prior to `export_as_docx`. Only the `titles_as_header` and #' `footer_as_text` parameters must be re-specified if the table is changed first using [tt_to_flextable()]. #' #' @seealso [tt_to_flextable()] @@ -103,7 +47,6 @@ export_as_docx <- function(tt, section_properties = section_properties_default(), ...) { # Checks - check_required_packages(c("flextable", "officer")) if (inherits(tt, "VTableTree")) { flex_tbl <- tt_to_flextable(tt, titles_as_header = titles_as_header, @@ -125,8 +68,36 @@ export_as_docx <- function(tt, fpt <- officer::fp_text(font.family = font_fam, font.size = font_sz_body) fpt_footer <- officer::fp_text(font.family = font_fam, font.size = font_sz_footer) } - } else { + } else if (inherits(tt, "flextable")) { flex_tbl <- tt + } else if (inherits(tt, "list")) { + export_as_docx(tt[[1]], # First paginated table that uses template_file + file = file, + doc_metadata = doc_metadata, + titles_as_header = titles_as_header, + footers_as_text = footers_as_text, + template_file = template_file, + section_properties = section_properties, + ... + ) + if (length(tt) > 1) { + out <- mapply( + export_as_docx, + tt = tt[-1], # Remaining paginated tables + MoreArgs = list( + file = file, + doc_metadata = doc_metadata, + titles_as_header = titles_as_header, + footers_as_text = footers_as_text, + template_file = file, # Uses the just-created file as template + section_properties = section_properties, + ... + ) + ) + } + return() + } else { + stop("The table must be a VTableTree, a flextable, or a list of VTableTree or flextable objects.") } if (!is.null(template_file) && !file.exists(template_file)) { template_file <- NULL @@ -139,8 +110,21 @@ export_as_docx <- function(tt, doc <- officer::read_docx() } - if (!is.null(section_properties)) { - doc <- officer::body_set_default_section(doc, section_properties) + # page width and orientation settings + doc <- officer::body_set_default_section(doc, section_properties) + if (flex_tbl$properties$layout != "autofit") { # fixed layout + page_width <- section_properties$page_size$width + dflx <- dim(flex_tbl) + if (abs(sum(unname(dflx$widths)) - page_width) > 1e-2) { + warning( + "The total table width does not match the page width. The column widths", + " will be resized to fit the page. Please consider modifying the parameter", + " total_page_width in tt_to_flextable()." + ) + + final_cwidths <- page_width * unname(dflx$widths) / sum(unname(dflx$widths)) + flex_tbl <- flextable::width(flex_tbl, width = final_cwidths) + } } # Extract title @@ -175,6 +159,8 @@ export_as_docx <- function(tt, # Save the Word document to a file print(doc, target = file) + + invisible(TRUE) } # Shorthand to add text paragraph diff --git a/R/package.R b/R/package.R index a7aa3ec..a973909 100644 --- a/R/package.R +++ b/R/package.R @@ -5,9 +5,6 @@ #' @importFrom magrittr %>% #' @importFrom stats setNames #' @import methods -#' @import formatters -#' @import rtables -#' @importFrom rtables import_from_tsv #' @import officer #' @import flextable NULL diff --git a/R/tt_to_paginate_office.R b/R/tt_to_paginate_office.R deleted file mode 100644 index d1f4832..0000000 --- a/R/tt_to_paginate_office.R +++ /dev/null @@ -1,17 +0,0 @@ -pos_to_path <- function(pos) { - spls <- rtables:::pos_splits(pos) - vals <- rtables:::pos_splvals(pos) - - path <- character() - for (i in seq_along(spls)) { - nm <- obj_name(spls[[i]]) - val_i <- value_names(vals[[i]]) - path <- c( - path, - obj_name(spls[[i]]), - ## rawvalues(vals[[i]])) - if (!is.na(val_i)) val_i - ) - } - path -} diff --git a/man/export_as_docx.Rd b/man/export_as_docx.Rd index 4bbdf1e..52fe489 100644 --- a/man/export_as_docx.Rd +++ b/man/export_as_docx.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tt_export.R +% Please edit documentation in R/export_as_docx.R \name{export_as_docx} \alias{export_as_docx} \alias{section_properties_default} @@ -74,7 +74,7 @@ the \code{officer} package. }} \note{ \code{export_as_docx()} has few customization options available. If you require specific formats and details, -we suggest that you use \code{\link[=tt_to_flextable]{tt_to_flextable()}} prior to \code{export_as_docx}. Only the \code{title_as_header} and +we suggest that you use \code{\link[=tt_to_flextable]{tt_to_flextable()}} prior to \code{export_as_docx}. Only the \code{titles_as_header} and \code{footer_as_text} parameters must be re-specified if the table is changed first using \code{\link[=tt_to_flextable]{tt_to_flextable()}}. } \examples{ diff --git a/man/reexports.Rd b/man/reexports.Rd deleted file mode 100644 index e9b2257..0000000 --- a/man/reexports.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tt_export.R -\docType{import} -\name{reexports} -\alias{reexports} -\alias{export_as_txt} -\alias{export_as_pdf} -\title{Objects exported from other packages} -\examples{ -lyt <- basic_table() \%>\% - split_cols_by("ARM") \%>\% - analyze(c("AGE", "BMRKR2", "COUNTRY")) - -tbl <- build_table(lyt, ex_adsl) - -cat(export_as_txt(tbl, file = NULL, paginate = TRUE, lpp = 8)) - -\dontrun{ -tf <- tempfile(fileext = ".txt") -export_as_txt(tbl, file = tf) -system2("cat", tf) -} - -lyt <- basic_table() \%>\% - split_cols_by("ARM") \%>\% - analyze(c("AGE", "BMRKR2", "COUNTRY")) - -tbl <- build_table(lyt, ex_adsl) - -\dontrun{ -tf <- tempfile(fileext = ".pdf") -export_as_pdf(tbl, file = tf, pg_height = 4) -tf <- tempfile(fileext = ".pdf") -export_as_pdf(tbl, file = tf, lpp = 8) -} - -} -\keyword{internal} -\description{ -These objects are imported from other packages. Follow the links -below to see their documentation. - -\describe{ - \item{formatters}{\code{\link[formatters]{export_as_pdf}}, \code{\link[formatters]{export_as_txt}}} -}} - diff --git a/man/tt_to_flextable.Rd b/man/tt_to_flextable.Rd index 263ae47..f9d4126 100644 --- a/man/tt_to_flextable.Rd +++ b/man/tt_to_flextable.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tt_as_flextable.R +% Please edit documentation in R/as_flextable.R \name{tt_to_flextable} \alias{tt_to_flextable} \alias{theme_docx_default} @@ -187,8 +187,6 @@ lyt <- basic_table( tbl <- build_table(lyt, ex_adsl) -# example code - # rtables style tt_to_flextable(tbl, theme = NULL) @@ -196,10 +194,12 @@ tt_to_flextable(tbl, theme = theme_docx_default(font_size = 6)) # Example with multiple themes (only extending the docx default!) my_theme <- function(x, ...) { - flextable::border_inner(x, part = "body", border = flextable::fp_border_default(width = 0.5)) + border_inner(x, part = "body", border = flextable::fp_border_default(width = 0.5)) } flx <- tt_to_flextable(tbl, theme = c(theme_docx_default(), my_theme)) +\dontshow{if (require(flextable)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(flextable) # Custom theme special_bold <- list( "header" = list("i" = 1, "j" = c(1, 3)), @@ -224,16 +224,13 @@ my_theme <- function(font_size = 6) { # here can pass additional arguments for d flx <- theme_docx_default(font_size = font_size)(flx, ...) # Then apply additional styling - flx <- flextable::border_inner(flx, - part = "body", - border = flextable::fp_border_default(width = 0.5) - ) + flx <- border_inner(flx, part = "body", border = flextable::fp_border_default(width = 0.5)) return(flx) } } flx <- tt_to_flextable(tbl, theme = my_theme()) - +\dontshow{\}) # examplesIf} } \seealso{ \code{\link[=export_as_docx]{export_as_docx()}} diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf index 90aa4ee3ef68c9c3938d4c88b088bcf2cc9e73be..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 100644 GIT binary patch literal 0 HcmV?d00001 literal 3830 zcmZ`+c|4SD+ZG|yVo&p=+=NEqHe-yv#8|Rq-$r~dJdg9d{y7gNJEEByRvnL0iXMx8 z9nFpI_hO>3fCfN6@+Zo`00o*bArefX(}*M(0x(29oCXe$#bPzETAJEgcoh_AL-+fC z@0=(w6^U{H%$X!cAcf2VY}qh_4I^Q8Ou8SN3^94PcyED;qXMdv{(sD1lT5Y3OL z0{2S|06K*-AOJKW!6Yg@008Ys0T2t&L zaL@r_(b-Hgk`Mn|J|5xcIIJOB02~P5umEUAp~8rM(2R1;$g zQq>0XqmYd0A%Ld_a;K$%=l#9^);&-CPqoO9$&L^Vc!J0?BNdM1PAy%+|2a^ere6ci&IopL9NL=5ZPaeG zJ0q5SuIFf=1HZ-QMvHXyJy;Pj%e$xf6bM8o2GKsfXaf#28dYGDUZId2zs|m5YCW1b zaEu|fJ>#HX8G7V)=xo>J5xJ#^qq&XT7Xh=J!Fs;aYq5g&tldPSHs!lXy&7*#I+YUO zE4*&g9G?J{Zp=BQE7`kRD)!06`cnfdStzp@%;2wi>Im`N}>KVS635n{?fr1#q8GfT%aeBvT!&_ucAmPOZy%*}i^ilFMD zmBb*5G@tj>I=hB1iCw-RU-Hc+_7={uo%P{94)@1Y1NN2<4|`dy%RQM63jGCFj~&Nv@F{4_3BVv#>r>P;yoE|{Dty=7)9*l!|V|UL{9ka?V06l zY%>@5+?CRsc`ZH7%=IOy&3OzdixszK@)L1*>f9|OpGn~rH!WY z9InZhBuwV}Pk2sX;6Lj5Hk;Js*#}CjNQVjU(hwvcG=hV4LA>A{zQEew=p|IU&BFvmz}Nn@>)~rfrL~mQ|Ln>mP;#1P0`;045 zwFzzq4TuJ|vPw-#_7?t%1eIt-`5^h}-PsB+6dHlE56t{TnFj9GFO6x+x$+~s@7U+< zaoe*VGbiP;cK`$L@v;voN^-?JEjW4o>teZEehBfH#fR$>J`XHTmfg4aD0C`-o!%w% zRpFe6%ygY}O+qV~DIW#@GM7?qO&T+KWuJ^$#ROo;PH`o+kYn8dd%$eceNtz$iDr>t zj{~K!iXIqSr6Qf2oNZZUnPYkC;W25I9r@dP1t#7t;8sX0>=k`yHD_Drrb*?;gvWbJ z${)YI7JBW&W6ObOkIe>NUe_Gp4D=7wTo1lJ(r-k$NQpc8=Fj)NI;9`rEkS9WvNKs{ zbQ8yi2jjH5@VoG?fiwNGJz0Z&gCF}J_LcPM6?}5K{O{@f?2<;4)wsp0Tb$c%%=0Qu z#;svd2;a7^^H?_=^)~9dQTyHV(VPQU^8^n(J|G&?6=T|LD9^C)?N~hB zFu!?x<9Kj?pCLbImIi*gN03pHrhPTT~sktZZs6Qkbd!) zlZAMZ$SST{a~_vi`KU6v@@i++g=sH>5=ue~G8sy_+0cp~;toXJC*JhIU3#72cy?Y{ zTW`rChnb^6_pKZHXw$j-BWM1OPqas~cduuj=Z#ywaN+pF73ZFk!qPC;sd9A>!=^TR zS9En;HRWg|rb=BE46jr7_qI)U>AiHN;#0(wXNq*PX{$D&mU``Z(lg9com$FFQHhP5 zRfv*|RhiXZ%MtopTGR6RF4yyiInT~iK{p=dQ@JjWTwV=MJs+;wfpJymf^yGy-fUzE zlg%HbUC_Vq{hSg0g546{iH)K~`J;`BPezG{_YICB@f4b<|lZMcS^7kK} z_PZ22yLv3q%6(_M!tShe3l$_Jb1rgpS9cQ3v=<}0R_f~x7F@4-*Anq6;$3u-0H-Uh zt4r;Y8dSz8y~_URd#|~3BqXx`MH{u0UR-lwCx4=1;?Bs+%hR7)4kVuVpBrgaoPcHT zAmQqQtCEvmFLfWE?^Bvio7%bWkC3XG_QK-VCpu@B2uVcq51J}ZuYyS_xnR%ep;*8*e#RhuyBeYvENnJ)s>!`iZiM^`O4@3_3?Ud@OnOe7|dBc}~Mt#&loDTKcOg`zQ357Paz? z4;nsCxU7_o*RW{ZVRx1cr{+ygUt{v>rKRl=_%9XSlYrsANkhFk-{x3-@^HoO{m{3C zh}#qLpGmE8-NgA_&&}JFIlICAKFc9%2M5n)7Ps!-`^{_h(VL;*J0WX04QYL?uU-pl z{pFVrU%T`4Ti*;c3qM`>;)*W!_qlM}K9V)6HWl=(;bO3)X5DPX?B4wsBPKp?Tlg?j zoNAjJA+QuTzxt2;TKCr)iu&OlOlioXPN5;@fw#8)_vA{U9iXu&KLHd-r1<+oh+*J4 z0#5+11qM-QY!;wP0FSZhFhqs?VH6gR2mR=X$6>K302sg|9Y=Ot5}D0gb;%SanH}U$ zg+c%jrcnJ5D2PO6(rEyAgbDG8NF<3&Mmz`#^rIl9SQHijs?+GOALI{!%h2uP;iF&q~0cE9m(y8pm5 zak_}#_{oErBnlN`BIXnT9VuZD(i;FCr1{ekcf>PGpaY!_13c6C-4n845)=MD1x+n2 M97;*a)Yc63zl^% diff --git a/tests/testthat/test-tt_as_flextable.R b/tests/testthat/test-as_flextable.R similarity index 77% rename from tests/testthat/test-tt_as_flextable.R rename to tests/testthat/test-as_flextable.R index e35ee6f..ba1b442 100644 --- a/tests/testthat/test-tt_as_flextable.R +++ b/tests/testthat/test-as_flextable.R @@ -18,8 +18,8 @@ test_that("Can create flextable object that works with different styles", { tbl <- build_table(lyt, ex_adsl) - ft <- tt_to_flextable(tbl, total_width = 20) - # expect_equal(sum(unlist(nrow(ft))), 20) + ft <- tt_to_flextable(tbl, total_page_width = 20) + expect_equal(sum(unlist(nrow(ft))), 20) expect_silent(ft3 <- tt_to_flextable(tbl, theme = NULL)) @@ -70,14 +70,8 @@ test_that("Can create flextable object that works with different styles", { expect_equal(flextable::nrow_part(topleft_t2, part = "header"), 2L) expect_equal(flextable::nrow_part(topleft_t1a, part = "header"), 1L) expect_equal(flextable::nrow_part(topleft_t1b, part = "header"), 1L) - - - # internal package check - not_a_pkg <- "bwrereloakdosirabttjtaeerr" - expect_error(check_required_packages(c("flextable", not_a_pkg)), not_a_pkg) }) - test_that("tt_to_flextable does not create different cells when colcounts (or multiple) on different lines", { lyt <- basic_table(show_colcounts = TRUE) %>% split_rows_by("ARM", label_pos = "topleft") %>% @@ -113,7 +107,6 @@ test_that("check titles bold and html theme", { expect_error(ft1 <- tt_to_flextable(tbl, theme = theme_html_default(), bold_titles = c(2, 3, 5))) }) - test_that("check pagination", { lyt <- basic_table(show_colcounts = TRUE) %>% split_rows_by("ARM", label_pos = "topleft", page_by = TRUE) %>% @@ -130,5 +123,38 @@ test_that("check pagination", { main_footer(tbl) <- c("Some Footer", "Mehr") prov_footer(tbl) <- "Some prov Footer" - # expect_silent(out <- tt_to_flextable(tbl, paginate = TRUE, lpp = 100)) + expect_warning(out <- tt_to_flextable(tbl, paginate = TRUE, lpp = 100)) + expect_equal(length(out), 3L) +}) + +test_that("check colwidths in flextable object", { + lyt <- basic_table(show_colcounts = TRUE) %>% + split_rows_by("ARM", label_pos = "topleft", page_by = TRUE) %>% + split_rows_by("STRATA1", label_pos = "topleft") %>% + split_cols_by("STRATA1", split_fun = keep_split_levels("B"), show_colcounts = TRUE) %>% + split_cols_by("SEX", split_fun = keep_split_levels(c("F", "M"))) %>% + split_cols_by("COUNTRY", split_fun = keep_split_levels("CHN")) %>% + analyze("AGE") + + tbl <- build_table(lyt, ex_adsl) + + main_title(tbl) <- "Main title" + subtitles(tbl) <- c("Some Many", "Subtitles") + main_footer(tbl) <- c("Some Footer", "Mehr") + prov_footer(tbl) <- "Some prov Footer" + + cw <- c(0.9, 0.05, 0.05) + spd <- section_properties_default(orientation = "landscape") + fin_cw <- cw * spd$page_size$width / 2 / sum(cw) + + # Fixed total width is / 2 + flx_res <- tt_to_flextable(tbl, + total_page_width = spd$page_size$width / 2, + counts_in_newline = TRUE, + autofit_to_page = TRUE, + bold_titles = TRUE, + colwidths = cw + ) # if you add cw then autofit_to_page = FALSE + dflx <- dim(flx_res) + testthat::expect_equal(fin_cw, unname(dflx$widths)) }) diff --git a/tests/testthat/test-export_as_docx.R b/tests/testthat/test-export_as_docx.R new file mode 100644 index 0000000..010e820 --- /dev/null +++ b/tests/testthat/test-export_as_docx.R @@ -0,0 +1,59 @@ +test_that("export_as_docx works thanks to tt_to_flextable", { + lyt <- make_big_lyt() + tbl <- build_table(lyt, rawdat) + top_left(tbl) <- "Ethnicity" + main_title(tbl) <- "Main title" + subtitles(tbl) <- c("Some Many", "Subtitles") + main_footer(tbl) <- c("Some Footer", "Mehr") + prov_footer(tbl) <- "Some prov Footer" + fnotes_at_path(tbl, rowpath = c("RACE", "BLACK")) <- "factor 2" + fnotes_at_path(tbl, + rowpath = c("RACE", "BLACK"), + colpath = c("ARM", "ARM1", "SEX", "F") + ) <- "factor 3" + + # Get the flextable + flex_tbl <- tt_to_flextable(tbl, titles_as_header = TRUE, footers_as_text = FALSE) + + doc_file <- tempfile(fileext = ".docx") + + expect_silent(export_as_docx(tbl, + file = doc_file, doc_metadata = list("title" = "meh"), + template_file = doc_file, + section_properties = section_properties_default() + )) + # flx table in input + expect_silent(export_as_docx(flex_tbl, + file = doc_file, doc_metadata = list("title" = "meh"), + template_file = doc_file, + section_properties = section_properties_default(page_size = "A4") + )) + expect_silent(export_as_docx(tbl, + file = doc_file, doc_metadata = list("title" = "meh"), + template_file = doc_file, + section_properties = section_properties_default(orientation = "landscape") + )) + + expect_true(file.exists(doc_file)) +}) + +test_that("export_as_docx produces a warning if manual column widths are used", { + skip_if_not_installed("flextable") + require("flextable", quietly = TRUE) + + lyt <- basic_table() %>% + split_rows_by("Species") %>% + analyze("Petal.Length") + tbl <- build_table(lyt, iris) + + doc_file <- tempfile(fileext = ".docx") + + # Get the flextable + expect_warning( + export_as_docx(tbl, + colwidths = c(1, 2), + file = doc_file, + section_properties = section_properties_default() + ), "The total table width does not match the page width" + ) +}) diff --git a/tests/testthat/test-exporters.R b/tests/testthat/test-exporters.R deleted file mode 100644 index 326590c..0000000 --- a/tests/testthat/test-exporters.R +++ /dev/null @@ -1,129 +0,0 @@ -context("Exporting to txt, pdf, rtf, and docx") - -test_that("export_as_txt works with and without pagination", { - lyt <- basic_table() %>% - split_cols_by("ARM") %>% - analyze(c("AGE", "BMRKR2", "COUNTRY")) - - tbl <- build_table(lyt, ex_adsl) - - tmptxtf <- tempfile() - export_as_txt(tbl, file = tmptxtf, paginate = TRUE, lpp = 8, verbose = TRUE) - txtlns <- readLines(tmptxtf) - expect_identical( - grep("\\\\s\\\\n", txtlns), - c(9L, 17L) - ) - - expect_identical( - toString(tbl), - export_as_txt(tbl, file = NULL, paginate = FALSE) - ) -}) - - - - -# test_that("exporting pdfs gives the correct values", { -# if (check_pdf) { -# lyt <- basic_table(title = " ") %>% -# split_rows_by("SEX", page_by = TRUE) %>% -# analyze("AGE") -# -# # Building the table -# tbl <- build_table(lyt, DM) -# -# tmpf <- tempfile(fileext = ".pdf") -# res <- export_as_pdf(tbl, file = tmpf, hsep = "=", lpp = 20) -# res_pdf <- pdf_text(tmpf) -# -# # Removing spaces and replacing separators -# res_pdf <- gsub(res_pdf, pattern = "==*", replacement = "+++") -# res_pdf <- gsub(res_pdf, pattern = " +", replacement = " ") -# res_pdf <- gsub(res_pdf, pattern = " \n", replacement = "") -# -# # Pagination is present as vector in pdf_text. Doing the same with tbl -# expected <- sapply(paginate_table(tbl), function(x) toString(x, hsep = "="), USE.NAMES = FALSE) -# names(expected) <- NULL -# -# # Removing spaces and replacing separators -# expected <- gsub(expected, pattern = "==*", replacement = "+++") -# expected <- gsub(expected, pattern = " +", replacement = " ") -# expected <- gsub(expected, pattern = " \n", replacement = "\n") -# expected <- gsub(expected, pattern = "^\n", replacement = "") -# expect_identical(res_pdf, expected) -# ## TODO understand better how to compare exactly these outputs -# } -# }) - - -## https://github.com/insightsengineering/rtables/issues/308 -test_that("path_enriched_df works for tables with a column that has all length 1 elements", { - my_table <- basic_table() %>% - split_rows_by("Species") %>% - analyze("Petal.Length") %>% - build_table(df = iris) - mydf <- path_enriched_df(my_table) - expect_identical(dim(mydf), c(3L, 2L)) -}) - - -test_that("export_as_doc works thanks to tt_to_flextable", { - lyt <- make_big_lyt() - tbl <- build_table(lyt, rawdat) - top_left(tbl) <- "Ethnicity" - main_title(tbl) <- "Main title" - subtitles(tbl) <- c("Some Many", "Subtitles") - main_footer(tbl) <- c("Some Footer", "Mehr") - prov_footer(tbl) <- "Some prov Footer" - fnotes_at_path(tbl, rowpath = c("RACE", "BLACK")) <- "factor 2" - fnotes_at_path(tbl, - rowpath = c("RACE", "BLACK"), - colpath = c("ARM", "ARM1", "SEX", "F") - ) <- "factor 3" - - # Get the flextable - flex_tbl <- tt_to_flextable(tbl, titles_as_header = TRUE, footers_as_text = FALSE) - - doc_file <- tempfile(fileext = ".docx") - - expect_silent(export_as_docx(tbl, - file = doc_file, doc_metadata = list("title" = "meh"), - template_file = doc_file, - section_properties = section_properties_default() - )) - # flx table in input - expect_silent(export_as_docx(flex_tbl, - file = doc_file, doc_metadata = list("title" = "meh"), - template_file = doc_file, - section_properties = section_properties_default(page_size = "A4") - )) - expect_silent(export_as_docx(tbl, - file = doc_file, doc_metadata = list("title" = "meh"), - template_file = doc_file, - section_properties = section_properties_default(orientation = "landscape") - )) - - expect_true(file.exists(doc_file)) -}) - - - - -test_that("export_as_doc produces a warning if manual column widths are used", { - lyt <- basic_table() %>% - split_rows_by("Species") %>% - analyze("Petal.Length") - tbl <- build_table(lyt, iris) - - doc_file <- tempfile(fileext = ".docx") - - # Get the flextable - expect_no_warning( - export_as_docx(tbl, - colwidths = c(1, 2), - file = doc_file, - section_properties = section_properties_default() - ) # , "The total table width does not match the page width" - ) -})