212 fixing r-code formating (#216)

# Pull Request fixes #212 Sample output generated from code. [report_230919205651.zip](https://github.com/insightsengineering/teal.reporter/files/12663270/report_230919205651.zip) [input_20230919205655718.pptx](https://github.com/insightsengineering/teal.reporter/files/12663273/input_20230919205655718.pptx) --------- Signed-off-by: kartikeya kirar <[email protected]> Co-authored-by: André Veríssimo <[email protected]> Co-authored-by: kartikeya <[email protected]> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Aleksander Chlebowski <[email protected]> Co-authored-by: Aleksander Chlebowski <[email protected]>
insightsengineering · Sep 29, 2023 · 6165a24 · 6165a24
1 parent 6a5664f
commit 6165a24
Show file tree

Hide file tree

Showing 8 changed files with 178 additions and 26 deletions.
diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml
@@ -27,6 +27,7 @@ jobs:
     with:
       additional-env-vars: |
         _R_CHECK_CRAN_INCOMING_REMOTE_=false
+        _R_CHECK_EXAMPLE_TIMING_THRESHOLD_=10
       additional-r-cmd-check-params: --as-cran
       enforce-note-blocklist: true
       note-blocklist: |

diff --git a/R/Renderer.R b/R/Renderer.R
@@ -33,10 +33,35 @@ Renderer <- R6::R6Class( # nolint: object_name_linter.
       if (missing(yaml_header)) {
         yaml_header <- md_header(yaml::as.yaml(list(title = "Report")))
       }
-      parsed_yaml <- yaml_header
+
+      private$report_type <- get_yaml_field(yaml_header, "output")
+      format_code_block_function <- paste0(
+        c(
+          "code_block <- function (code_text) {",
+          "  df <- data.frame(code_text)",
+          "  ft <- flextable::flextable(df)",
+          "  ft <- flextable::delete_part(ft, part = 'header')",
+          "  ft <- flextable::autofit(ft, add_h = 0)",
+          "  ft <- flextable::fontsize(ft, size = 7, part = 'body')",
+          "  ft <- flextable::bg(x = ft, bg = 'lightgrey')",
+          "  ft <- flextable::border_outer(ft)",
+          "  if (flextable::flextable_dim(ft)$widths > 8) {",
+          "    ft <- flextable::width(ft, width = 8)",
+          "  }",
+          "  ft",
+          "}"
+        ),
+        collapse = "\n"
+      )
+
       parsed_global_knitr <- sprintf(
-        "\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(%s)\n```\n",
-        capture.output(dput(global_knitr))
+        "\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(%s)\n%s\n```\n",
+        capture.output(dput(global_knitr)),
+        if (identical(private$report_type, "powerpoint_presentation")) {
+          format_code_block_function
+        } else {
+          ""
+        }
       )
 
       parsed_blocks <- paste(
@@ -46,7 +71,7 @@ Renderer <- R6::R6Class( # nolint: object_name_linter.
         collapse = "\n\n"
       )
 
-      rmd_text <- paste0(parsed_yaml, "\n", parsed_global_knitr, "\n", parsed_blocks, "\n")
+      rmd_text <- paste0(yaml_header, "\n", parsed_global_knitr, "\n", parsed_blocks, "\n")
       tmp <- tempfile(fileext = ".Rmd")
       input_path <- file.path(
         private$output_dir,
@@ -88,6 +113,7 @@ Renderer <- R6::R6Class( # nolint: object_name_linter.
   ),
   private = list(
     output_dir = character(0),
+    report_type = NULL,
     # factory method
     block2md = function(block) {
       if (inherits(block, "TextBlock")) {
@@ -119,18 +145,22 @@ Renderer <- R6::R6Class( # nolint: object_name_linter.
     rcodeBlock2md = function(block) {
       params <- block$get_params()
       params <- lapply(params, function(l) if (is.character(l)) shQuote(l) else l)
-      block_content <- block$get_content()
-      paste(
-        sep = "\n",
-        collapse = "\n",
-        "### ",
+      if (identical(private$report_type, "powerpoint_presentation")) {
+        block_content_list <- split_text_block(block$get_content(), 30)
+        paste(
+          sprintf(
+            "---\n\n```{r, echo=FALSE}\ncode_block(\n%s)\n```\n",
+            shQuote(block_content_list, type = "cmd")
+          ),
+          collapse = "\n\n"
+        )
+      } else {
         sprintf(
-          "```{r, %s}", paste(names(params), params, sep = "=", collapse = ", ")
-        ),
-        block_content,
-        "```",
-        ""
-      )
+          "--- \n\n```{r, %s}\n%s\n```\n",
+          paste(names(params), params, sep = "=", collapse = ", "),
+          block$get_content()
+        )
+      }
     },
     pictureBlock2md = function(block) {
       basename_pic <- basename(block$get_content())

diff --git a/R/utils.R b/R/utils.R
@@ -115,7 +115,7 @@ panel_item <- function(title, ..., collapsed = TRUE, input_id = NULL) {
 #' Indent the row names by 10 times indentation
 #'
 #' @param content Supported formats: `data.frame`, `rtables`, `TableTree`, `ElementaryTable`, `listing_df`
-
+#'
 #' @return (`flextable`)
 #'
 #' @keywords internal
@@ -185,6 +185,7 @@ to_flextable <- function(content) {
 #'
 #' @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)
@@ -247,3 +248,32 @@ padding_lst <- function(ft, indents) {
     flextable::padding(ft, s, 1, padding.left = (indents[s] + 1) * 10)
   }, seq_len(length(indents)), ft)
 }
+
+#' Split a text block into smaller blocks with a specified number of lines.
+#'
+#' Divide text block into smaller blocks.
+#'
+#' A single character string containing a text block of multiple lines (separated by `\n`)
+#' is split into multiple strings with n or less lines each.
+#'
+#' @param block_text `character` string containing the input block of text
+#' @param n `integer` number of lines per block
+#'
+#' @return
+#' List of character strings with up to `n` lines in each element.
+#'
+#' @keywords internal
+split_text_block <- function(x, n) {
+  checkmate::assert_string(x)
+  checkmate::assert_integerish(n, lower = 1L, len = 1L)
+
+  lines <- strsplit(x, "\n")[[1]]
+
+  if (length(lines) <= n) {
+    return(list(x))
+  }
+
+  nblocks <- ceiling(length(lines) / n)
+  ind <- rep(1:nblocks, each = n)[seq_along(lines)]
+  unname(lapply(split(lines, ind), paste, collapse = "\n"))
+}
diff --git a/R/yaml_utils.R b/R/yaml_utils.R
@@ -238,3 +238,26 @@ as_yaml_auto <- function(input_list,
 print.rmd_yaml_header <- function(x, ...) {
   cat(x, ...)
 }
+
+#' Parses `yaml` text, extracting the specified field. Returns list names if it's a list;
+#' otherwise, the field itself.
+#'
+#' @param yaml_text A character vector containing the `yaml` text.
+#' @param field_name The name of the field to extract.
+#'
+#' @return if the field is a list, it returns the names of elements in the list; otherwise,
+#' it returns the extracted field.
+#'
+#' @keywords internal
+get_yaml_field <- function(yaml_text, field_name) {
+  checkmate::assert_multi_class(yaml_text, c("rmd_yaml_header", "character"))
+  checkmate::assert_string(field_name)
+
+  yaml_obj <- yaml::yaml.load(yaml_text)
+
+  result <- yaml_obj[[field_name]]
+  if (is.list(result)) {
+    result <- names(result)
+  }
+  result
+}
diff --git a/man/get_yaml_field.Rd b/man/get_yaml_field.Rd
diff --git a/man/split_text_block.Rd b/man/split_text_block.Rd
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -17,37 +17,51 @@ testthat::test_that("to_flextable: unsupported class", {
   expect_error(to_flextable(unsupported_data), "Unsupported class")
 })
 
-test_that("custom_theme to flextable", {
+testthat::test_that("custom_theme to flextable", {
   sample_ft <- flextable::qflextable(head(mtcars))
   themed_ft <- custom_theme(sample_ft)
-  expect_is(themed_ft, "flextable")
+  testthat::expect_is(themed_ft, "flextable")
 })
 
-test_that("get_merge_index_single", {
+testthat::test_that("get_merge_index_single", {
   sample_span <- c(1, 2, 1, 3)
   merge_index <- get_merge_index_single(sample_span)
-  expect_is(merge_index, "list")
+  testthat::expect_is(merge_index, "list")
 })
 
-test_that("get_merge_index", {
+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)
-  expect_is(merge_index, "list")
+  testthat::expect_is(merge_index, "list")
 })
 
-test_that("merge_at_indice", {
+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")
-  expect_is(merged_ft, "flextable")
+  testthat::expect_is(merged_ft, "flextable")
 })
 
-test_that("padding_lst applies padding to a flextable based on indentation levels", {
+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)
-  expect_is(padded_ft, "flextable")
+  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")
+  n <- 2
+  result <- split_text_block(block_text, n)
+  result_lines <- lapply(result, function(x) strsplit(x, "\n")[[1]])
+  lapply(result_lines, function(x) testthat::expect_lte(length(x), n))
+
+  n <- 5
+  result <- split_text_block(block_text, n)
+  testthat::expect_equal(result, list(block_text))
 })
diff --git a/tests/testthat/test-yaml_utils.R b/tests/testthat/test-yaml_utils.R
@@ -139,3 +139,10 @@ testthat::test_that("as_yaml_auto - accept multi outputs with the multi_output a
     NA
   )
 })
+
+testthat::test_that("get_yaml_field returns the correct result", {
+  yaml_text <- "---\nauthor: ''\ndate: '2022-04-29'\noutput:\n  pdf_document:\n    toc: yes\n    keep_tex: yes\n---\n"
+  field_name <- "output"
+  result <- get_yaml_field(yaml_text, field_name)
+  testthat::expect_equal(result, "pdf_document")
+})