use rtables pkg function for generating report

DESCRIPTION

@@ -31,6 +31,7 @@ Imports:
     lifecycle (>= 0.2.0),
     R6,
     rmarkdown (>= 2.19),
+    rtables (>= 0.5.1),
     shiny (>= 1.6.0),
     shinybusy,
     shinyWidgets (>= 0.5.1),
@@ -42,7 +43,6 @@ Suggests:
     ggplot2 (>= 3.4.0),
     lattice (>= 0.18-4),
     png,
-    rtables (>= 0.5.1),
     testthat (>= 3.1.5),
     tinytex
 VignetteBuilder:
@@ -51,11 +51,10 @@ RdMacros:
     lifecycle
 Config/Needs/verdepcheck: rstudio/bslib, mllg/checkmate,
     rstudio/htmltools, yihui/knitr, r-lib/lifecycle, r-lib/R6,
-    rstudio/rmarkdown, rstudio/shiny, dreamRs/shinybusy,
-    dreamRs/shinyWidgets, yaml=vubiostat/r-yaml, r-lib/zip,
+    rstudio/rmarkdown, insightsengineering/rtables, rstudio/shiny, 
+    dreamRs/shinybusy, dreamRs/shinyWidgets, yaml=vubiostat/r-yaml, r-lib/zip,
     davidgohel/flextable, rstudio/DT, yihui/formatR, tidyverse/ggplot2,
-    deepayan/lattice, cran/png, insightsengineering/rtables,
-    r-lib/testthat, rstudio/tinytex
+    deepayan/lattice, cran/png, r-lib/testthat, rstudio/tinytex
 Config/Needs/website: insightsengineering/nesttemplate
 Encoding: UTF-8
 Language: en-US

R/utils.R

@@ -124,79 +124,35 @@ panel_item <- function(title, ..., collapsed = TRUE, input_id = NULL) {
 #'
 #' @keywords internal
 to_flextable <- function(content) {
-  if (inherits(content, c("rtables", "TableTree", "ElementaryTable", "listing_df"))) {
+  if (inherits(content, c("rtables", "TableTree", "ElementaryTable"))) {
+    ft <- rtables::tt_to_flextable(content)
+  } else if (inherits(content, "listing_df")) {
     mf <- rtables::matrix_form(content)
     nr_header <- attr(mf, "nrow_header")
-    non_total_coln <- c(TRUE, !grepl("All Patients", names(content)))
     df <- as.data.frame(mf$strings[seq(nr_header + 1, nrow(mf$strings)), , drop = FALSE])
     header_df <- as.data.frame(mf$strings[seq_len(nr_header), , drop = FALSE])
 
-    ft <- flextable::flextable(df)
-    ft <- flextable::delete_part(ft, part = "header")
-    ft <- flextable::add_header(ft, values = header_df)
-
-    # Add titles
-    ft <- flextable::set_caption(ft, flextable::as_paragraph(
-      flextable::as_b(mf$main_title), "\n", paste(mf$subtitles, collapse = "\n")
-    ),
-    align_with_table = FALSE
-    )
-
-    merge_index_body <- get_merge_index(mf$spans[seq(nr_header + 1, nrow(mf$spans)), , drop = FALSE])
-    merge_index_header <- get_merge_index(mf$spans[seq_len(nr_header), , drop = FALSE])
-
-    ft <- merge_at_indice(ft, lst = merge_index_body, part = "body")
-    ft <- merge_at_indice(ft, lst = merge_index_header, part = "header")
-    ft <- flextable::align_text_col(ft, align = "center", header = TRUE)
-    ft <- flextable::align(ft, i = seq_len(nrow(content)), j = 1, align = "left")
-    ft <- padding_lst(ft, mf$row_info$indent)
-    ft <- flextable::padding(ft, padding.top = 1, padding.bottom = 1, part = "all")
-    ft <- flextable::autofit(ft, add_h = 0)
-
-    width_vector <- c(
-      dim(ft)$widths[1],
-      rep(sum(dim(ft)$widths[-1]), length(dim(ft)$widths) - 1) / (ncol(mf$strings) - 1)
-    )
-    ft <- flextable::width(ft, width = width_vector)
-    ft <- custom_theme(ft)
-
-    # Add footers
-    ft <- flextable::add_footer_lines(ft, flextable::as_paragraph(
-      flextable::as_chunk(mf$main_footer, props = flextable::fp_text_default(font.size = 8))
-    ))
-    if (length(mf$main_footer) > 0 && length(mf$prov_footer) > 0) ft <- flextable::add_footer_lines(ft, c("\n"))
-    ft <- flextable::add_footer_lines(ft, flextable::as_paragraph(
-      flextable::as_chunk(mf$prov_footer, props = flextable::fp_text_default(font.size = 8))
-    ))
+    ft <- rtables::df_to_tt(df)
+    rtables::main_title(ft) <- mf$main_title
+    rtables::subtitles(ft) <- mf$subtitles
+    rtables::main_footer(ft) <- mf$main_footer
+    rtables::prov_footer(ft) <- mf$prov_footer
+    rtables::header_section_div(ft) <- mf$header_section_div
+    content <- ft
+    ft <- rtables::tt_to_flextable(ft, total_width = c(grDevices::pdf.options()$width - 1))
   } else if (inherits(content, "data.frame")) {
-    ft <- flextable::flextable(content)
-    ft <- custom_theme(ft)
+    ft <- rtables::df_to_tt(content)
+    content <- ft
+    ft <- rtables::tt_to_flextable(ft)
   } else {
     stop(paste0("Unsupported class `(", format(class(content)), ")` when exporting table"))
   }
 
-  if (flextable::flextable_dim(ft)$widths > 10) {
-    pgwidth <- 10.5
-    width_vector <- dim(ft)$widths * pgwidth / flextable::flextable_dim(ft)$widths
-    ft <- flextable::width(ft, width = width_vector)
-  }
+  ft <- rtables::theme_docx_default(tt = content)(ft)
 
   ft
 }
 
-#' Apply a custom theme to a `flextable`
-#' @noRd
-#' @keywords internal
-custom_theme <- function(ft) {
-  checkmate::assert_class(ft, "flextable")
-  ft <- flextable::fontsize(ft, size = 8, part = "body")
-  ft <- flextable::bold(ft, part = "header")
-  ft <- flextable::theme_booktabs(ft)
-  ft <- flextable::hline(ft, border = flextable::fp_border_default(width = 1, color = "grey"))
-  ft <- flextable::border_outer(ft)
-  ft
-}
-
 #' Get the merge index for a single span.
 #' This function retrieves the merge index for a single span,
 #' which is used in merging cells.
@@ -214,40 +170,6 @@ get_merge_index_single <- function(span) {
   return(ret)
 }
 
-#' Get the merge index for multiple spans.
-#' This function merges cells in a `flextable` at specified row and column indices.
-#' @noRd
-#' @keywords internal
-get_merge_index <- function(spans) {
-  ret <- lapply(seq_len(nrow(spans)), function(i) {
-    ri <- spans[i, ]
-    r <- get_merge_index_single(ri)
-    lapply(r, function(s) {
-      list(j = s, i = i)
-    })
-  })
-  unlist(ret, recursive = FALSE, use.names = FALSE)
-}
-
-#' Merge cells in a `flextable` at specified indices
-#' @noRd
-#' @keywords internal
-merge_at_indice <- function(ft, lst, part) {
-  Reduce(function(ft, ij) {
-    flextable::merge_at(ft, i = ij$i, j = ij$j, part = part)
-  }, lst, ft)
-}
-
-#' Apply padding to a `flextable` based on indentation levels.
-#' This function applies padding to a `flextable` based on indentation levels provided as a vector.
-#' @noRd
-#' @keywords internal
-padding_lst <- function(ft, indents) {
-  Reduce(function(ft, s) {
-    flextable::padding(ft, s, 1, padding.left = (indents[s] + 1) * 10)
-  }, seq_len(length(indents)), ft)
-}
-
 #' Divide text block into smaller blocks
 #'
 #' Split a text block into smaller blocks with a specified number of lines.

tests/testthat/test-utils.R

@@ -17,42 +17,6 @@ testthat::test_that("to_flextable: unsupported class", {
   testthat::expect_error(to_flextable(unsupported_data), "Unsupported class")
 })
 
-testthat::test_that("custom_theme to flextable", {
-  sample_ft <- flextable::qflextable(head(mtcars))
-  themed_ft <- custom_theme(sample_ft)
-  testthat::expect_is(themed_ft, "flextable")
-})
-
-testthat::test_that("get_merge_index_single", {
-  sample_span <- c(1, 2, 1, 3)
-  merge_index <- get_merge_index_single(sample_span)
-  testthat::expect_is(merge_index, "list")
-})
-
-testthat::test_that("get_merge_index", {
-  sample_spans <- matrix(c(1, 2, 1, 3, 2, 1, 1, 1), ncol = 2)
-  merge_index <- get_merge_index(sample_spans)
-  testthat::expect_is(merge_index, "list")
-})
-
-testthat::test_that("merge_at_indice", {
-  sample_ft <- flextable::qflextable(head(mtcars))
-  merge_indices <- list(
-    list(i = 1, j = 1:2),
-    list(i = 2, j = 3:4)
-  )
-  merged_ft <- merge_at_indice(sample_ft, lst = merge_indices, part = "body")
-  testthat::expect_is(merged_ft, "flextable")
-})
-
-testthat::test_that("padding_lst applies padding to a flextable based on indentation levels", {
-  sample_ft <- flextable::qflextable(head(mtcars))
-  sample_indents <- c(1, 2, 1, 3, 2)
-  padded_ft <- padding_lst(sample_ft, sample_indents)
-  testthat::expect_is(padded_ft, "flextable")
-})
-
-
 testthat::test_that("split_text_block - splits text block into blocks no longer than n lines", {
   l <- 5
   block_text <- paste(paste(rep("Line", l), seq_len(l)), collapse = "\n")