212 fixing r-code formating

.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: |

R/Renderer.R

@@ -33,10 +33,16 @@ 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 <- reverse_yaml_field(yaml_header, "output")
       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")) {
+          paste0("code_block <- ", paste(deparse(format_code_block_for_slide), collapse = "\n"))
+        } else {
+          character(0)
+        }
       )
 
       parsed_blocks <- paste(
@@ -46,7 +52,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 +94,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 +126,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())

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,51 @@ 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(x)
+  }
+
+  nblocks <- ceiling(length(lines) / n)
+  ind <- rep(1:nblocks, each = n)[seq_along(lines)]
+  unname(lapply(split(lines, ind), paste, collapse = "\n"))
+}
+
+#' This function converts code text into an formatted flextable,
+#' designed for enhancing code readability in R Markdown presentations.
+#' @noRd
+#'
+#' @keywords internal
+format_code_block_for_slide <- 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
+}

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
+reverse_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
+}

tests/testthat/test-utils.R

@@ -51,3 +51,24 @@ test_that("padding_lst applies padding to a flextable based on indentation level
   padded_ft <- padding_lst(sample_ft, sample_indents)
   expect_is(padded_ft, "flextable")
 })
+
+block_text <- "Line 1\nLine 2\nLine 3\nLine 4\nLine 5\nLine 6"
+
+test_that("split_text_block - splits text block into equal parts", {
+  n <- 2
+  result <- split_text_block(block_text, n)
+  expected_result <- list("Line 1\nLine 2", "Line 3\nLine 4", "Line 5\nLine 6")
+  expect_equal(result, expected_result)
+})
+
+test_that("split_text_block - n greater than the number of line breaks", {
+  n <- 7
+  result <- split_text_block(block_text, n)
+  expect_equal(result, block_text)
+})
+
+test_that("format_code_block_for_slide", {
+  code_block <- "library(flextable)\nprint('Hello, world!')"
+  formatted_table <- format_code_block_for_slide(code_block)
+  expect_is(formatted_table, "flextable")
+})

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
   )
 })
+
+test_that("reverse_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 <- reverse_yaml_field(yaml_text, field_name)
+  expect_equal(result, "pdf_document")
+})