Merge pull request #71 from metrumresearchgroup/patch/trac-mat

Traceability matrix adjustment

Author: barrettk

R/format-report.R

@@ -686,11 +686,48 @@ format_traceability_matrix <- function(
   checkmate::assert_logical(wrap_cols)
 
   if(!is.null(exports_df)){
-    ### Exported Functions ###
-    # Unnest tests and testing directories
+    if ("exported_function" %in% names(exports_df)) {
+      # Align internal scoring with external format.
+      exports_df <- dplyr::rename(exports_df, entrypoint = "exported_function")
+    }
+
+    entry_name <- switch(scorecard_type,
+                         "R" = "Exported Function",
+                         "cli" = "Command",
+                         "Entry Point"
+    )
+    exports_df <- dplyr::rename(exports_df, !!entry_name := "entrypoint")
+
+    # Unnest and wrap collapsed columns to display
     exported_func_df <- exports_df %>%
-      mutate(
-        test_files = purrr::map_chr(.data$test_files, ~paste(.x, collapse = "\n"))
+      dplyr::mutate(
+        dplyr::across(
+          all_of(c(entry_name, "code_file", "documentation")),
+          function(col){
+            purrr::map_chr(col, function(cell){
+              # Replace NA values with empty strings for display purposes
+              cell[is.na(cell)] <- ""
+              # Wrap text
+              if(isTRUE(wrap_cols)){
+                cell <- wrap_text(cell, width = 24, indent = TRUE, strict = TRUE)
+              }
+              paste(cell, collapse = "\n")
+            })
+          }
+        ),
+        # Tests can be longer due to page width (pg_width) settings (we make it wider)
+        test_files = purrr::map_chr(.data$test_files, function(tests){
+          # Replace NA values with empty strings for display purposes
+          tests[is.na(tests)] <- ""
+          # Wrap text
+          if(isTRUE(wrap_cols)){
+            # flextable will make its own new line at rendering at 35 characters
+            # given the current column widths. A width of 34 is therefore the largest
+            # we can allow if indents are desired (they wont get triggered by flextable's auto newlines)
+            tests <- wrap_text(tests, width = 34, indent = TRUE, strict = TRUE)
+          }
+          paste(tests, collapse = "\n")
+        })
       )
 
     # Get testing directories for caption
@@ -703,40 +740,13 @@ format_traceability_matrix <- function(
       test_dirs <- NULL
     }
 
-    if ("exported_function" %in% names(exported_func_df)) {
-      # Align internal scoring with external format.
-      exported_func_df <- dplyr::rename(exported_func_df,
-        entrypoint = "exported_function"
-      )
-    }
-
-    entry_name <- switch(scorecard_type,
-      "R" = "Exported Function",
-      "cli" = "Command",
-      "Entry Point"
-    )
-    exported_func_df <- dplyr::rename(
-      exported_func_df,
-      !!entry_name := "entrypoint"
-    )
-
-    # Format Table
-    if(isTRUE(wrap_cols)){
-      exported_func_df <- exported_func_df %>%
-        dplyr::mutate(
-          dplyr::across(
-            all_of(c(entry_name, "code_file", "documentation")),
-            function(x) wrap_text(x, width = 24, indent = TRUE, strict = TRUE)
-          ),
-          # Tests can be longer due to page width (pg_width) settings (we make it wider)
-          test_files = purrr::map_chr(.data$test_files, function(tests){
-            wrap_text(tests, width = 40, strict = TRUE)
-          })
-        )
-    }
-    exported_func_df <- exported_func_df %>% format_colnames_to_title()
+    # For exports that span more than a page (usually due to many tests), split
+    # the entry into `export` and `export (cont.)`. This is necessary to ensure
+    # tables do not overflow into the footer
+    exported_func_df <- split_long_rows(exported_func_df, n = 40)
 
     # Create flextable
+    exported_func_df <- exported_func_df %>% format_colnames_to_title()
     exported_func_flex <- flextable_formatted(exported_func_df, pg_width = 7, font_size = 9) %>%
       flextable::set_caption("Traceability Matrix")
 
@@ -757,6 +767,100 @@ format_traceability_matrix <- function(
   }
 }
 
+
+#' Split Long Rows in a Data Frame by Newline Count
+#'
+#' This function processes a data frame to split rows where the content in
+#' specific columns exceeds a specified number of newline characters.
+#' Rows with content that spans more than `n` lines will be split into
+#' multiple rows, with the excess content carried over into continuation
+#' rows. The new rows will be labeled with "(cont.)" to indicate continuation.
+#'
+#' @param exported_func_df A data frame containing columns `code_file`,
+#' `documentation`, and `test_files`, where the contents are character strings
+#' that may span multiple lines.
+#' @param n An integer specifying the maximum number of newline characters
+#' allowed in each row's content. Default is 40.
+#'
+#' @return A data frame with rows split based on newline character count.
+#' Each original row that exceeds the specified number of lines will be split
+#' into multiple rows with continuation labels.
+#'
+#' @note This function assumes the `entry_name`, a column determined early on in
+#' `format_traceability_matrix`, is the first column in the dataframe.
+#' @examples
+#' \dontrun{
+#'
+#' split_df <- split_long_rows(exported_func_df)
+#' }
+#' @keywords internal
+split_long_rows <- function(exported_func_df, n = 40) {
+
+  # Helper function to split content by newlines
+  split_by_newlines <- function(content, n) {
+    content_split <- strsplit(content, "\n")[[1]]
+    split_list <- split(content_split, ceiling(seq_along(content_split) / n))
+    lapply(split_list, paste, collapse = "\n")
+  }
+
+  entry_name <- names(exported_func_df)[1]
+  temp_cols <- c("code_file_split", "documentation_split", "test_files_split", "n_lines")
+
+  # Split contents and create new rows
+  exported_func_df %>%
+    dplyr::mutate(
+      # Split contents if n_lines > n
+      code_file_split = purrr::map(.data$code_file, ~ split_by_newlines(.x, n = n)),
+      documentation_split = purrr::map(.data$documentation, ~ split_by_newlines(.x, n = n)),
+      test_files_split = purrr::map(.data$test_files, ~ split_by_newlines(.x, n = n))
+    ) %>%
+    dplyr::rowwise() %>%
+    # Expand each row if any of the splits are greater than 1
+    dplyr::group_split() %>%
+    purrr::map_dfr(function(row_data) {
+      n_chunks <- max(length(row_data$code_file_split[[1]]),
+                      length(row_data$documentation_split[[1]]),
+                      length(row_data$test_files_split[[1]]))
+
+      # Create a list of new rows
+      purrr::map_dfr(1:n_chunks, function(i) {
+        new_row <- row_data
+
+        # Extract split contents or default to an empty string
+        new_row$code_file <- ifelse(
+          length(new_row$code_file_split[[1]]) >= i,
+          new_row$code_file_split[[1]][[i]],
+          ""
+        )
+        new_row$documentation <- ifelse(
+          length(new_row$documentation_split[[1]]) >= i,
+          new_row$documentation_split[[1]][[i]],
+          ""
+        )
+        new_row$test_files <- ifelse(
+          length(new_row$test_files_split[[1]]) >= i,
+          new_row$test_files_split[[1]][[i]],
+          ""
+        )
+
+        # Label the continuation rows
+        new_row[[entry_name]] <- ifelse(i == 1, new_row[[entry_name]], paste0(new_row[[entry_name]], " (cont.)"))
+
+        # Recalculate the n_lines for the new row
+        new_row$n_lines <- max(
+          length(strsplit(new_row$code_file, "\n")[[1]]),
+          length(strsplit(new_row$documentation, "\n")[[1]]),
+          length(strsplit(new_row$test_files, "\n")[[1]])
+        )
+
+        new_row
+      })
+    }) %>%
+    dplyr::ungroup() %>%
+    dplyr::select(-all_of(temp_cols))
+}
+
+
 #' Print boiler plate text about the traceability matrix
 #' @inheritParams format_traceability_matrix
 #' @noRd
@@ -798,7 +902,7 @@ format_appendix <- function(extra_notes_data, return_vals = FALSE, scorecard_typ
     cov_results_df <- cov_results_df %>%
       dplyr::mutate(
         code_file = wrap_text(.data$code_file,
-          width = 43, indent = TRUE, strict = TRUE
+                              width = 43, indent = TRUE, strict = TRUE
         ),
         test_coverage = sprintf("%.2f%%", .data$test_coverage)
       ) %>%