Feature suggestion: table formatting

R/coverage-matrix.R

@@ -50,8 +50,8 @@ vt_scrape_coverage_matrix <- function(type = c("long", "wide"),
     # req_title uses only first numeric position
     out$req_title <- factor(out$req_title,
                             levels = paste0("Requirement ", 
-                                            sort(as.numeric(unique(unlist(lapply(strsplit(out$req_title, split = " "), 
-                                                        function(x){x[2]})))))))
+                                            sort(unique(unlist(lapply(strsplit(out$req_title, split = " "), 
+                                                        function(x){x[2]}))))))
     out[order(out$req_title),]
 
   }
@@ -127,15 +127,15 @@ vt_scrape_coverage_matrix <- function(type = c("long", "wide"),
 #' @importFrom knitr kable
 #' @importFrom kableExtra kable_styling collapse_rows add_header_above
 #' @export
-vt_kable_coverage_matrix <- function(x, format = vt_render_to()){
+vt_kable_coverage_matrix <- function(x, format = vt_render_to(), ...){
   switch(attr(x, "table_type"),
-         "long" = kable_cov_matrix_long(x, format = format),
-         "wide" = kable_cov_matrix_wide(x, format = format))
+         "long" = kable_cov_matrix_long(x, format = format, ...),
+         "wide" = kable_cov_matrix_wide(x, format = format, ...))
 
 }
 
 
-kable_cov_matrix_long <- function(x, format = vt_render_to()){
+kable_cov_matrix_long <- function(x, format = vt_render_to(), ...){
   this_col_names <- c("Requirement Name", "Requirement ID", "Test Case Name", "Test Cases")
   if(all(x$deprecate == "")){
     x <- x[,-which(names(x) == "deprecate")]
@@ -149,7 +149,7 @@ kable_cov_matrix_long <- function(x, format = vt_render_to()){
   out_tab <- kable_styling(out_tab, font_size = 6)
   out_tab <- column_spec(out_tab, 1, border_left = TRUE)
   out_tab <- column_spec(out_tab, ncol(x), border_right = TRUE)
-  out_tab <- collapse_rows(out_tab, c(1, 3))
+  out_tab <- collapse_rows(out_tab, c(1, 3), ...)
   out_tab
 }
 

R/evaluate_test_code.R

@@ -56,8 +56,11 @@ vt_kable_test_code_results <- function(results, format = vt_render_to()) {
 
   x <- results[, c("Test", "Results", "Pass_Fail")]
   colnames(x) <- c("Test", "Results", "Pass/Fail")
+  if (nrow(x) > 0) {
+    x$Results <- gsub("\n","", gsub("\a|\033","", x$Results))
+  }
 
-  t <- kable(x,format = format)
+  t <- kable(x, format = format, longtable = TRUE)
 
   if(nrow(results) > 0){
     t <- column_spec(t, 2:3, width = "10em")

R/scrape_authorship.R

@@ -136,7 +136,8 @@ vt_scrape_function_editors  <- function(tags = c("editor", "editDate", "export")
 #' @importFrom knitr kable
 #' @rdname scraping
 #'
-vt_kable_requirement_editors  <- function(x,format = vt_render_to()){
+vt_kable_requirement_editors  <- function(x,format = vt_render_to(),
+                                          latex_options = "hold_position"){
   all_colnames <- c(requirements = "Requirement ID",
                     editor = "Editor",
                     editDate = "Edit Date")
@@ -145,7 +146,7 @@ vt_kable_requirement_editors  <- function(x,format = vt_render_to()){
              col.names = all_colnames)
   t <- column_spec(t, 1, border_left = TRUE)
   t <- column_spec(t, ncol(x), border_right = TRUE)
-  t <- kable_styling(t, latex_options = "hold_position")
+  t <- kable_styling(t, latex_options = latex_options)
   t
 }
 
@@ -178,7 +179,8 @@ vt_kable_function_editors  <- function(x,format = vt_render_to()){
 #' @importFrom knitr kable
 #' @rdname scraping
 #'
-vt_kable_test_case_editors  <- function(x,format = vt_render_to()){
+vt_kable_test_case_editors  <- function(x,format = vt_render_to(), 
+                                        latex_options = "hold_position"){
     all_colnames <- c(test_cases = "Test Case ID",
                     editor = "Editor",
                     editDate = "Edit Date")
@@ -187,7 +189,7 @@ vt_kable_test_case_editors  <- function(x,format = vt_render_to()){
              col.names = all_colnames)
   t <- column_spec(t, 1, border_left = TRUE)
   t <- column_spec(t, length(all_colnames), border_right = TRUE)
-  t <- kable_styling(t, latex_options = "hold_position")
+  t <- kable_styling(t, latex_options = latex_options)
   t
 }
 
@@ -196,7 +198,8 @@ vt_kable_test_case_editors  <- function(x,format = vt_render_to()){
 #' @importFrom knitr kable
 #' @rdname scraping
 #'
-vt_kable_test_code_editors <- function(x,format = vt_render_to()){
+vt_kable_test_code_editors <- function(x, format = vt_render_to(),
+                                       latex_options = "hold_position", ...){
   all_colnames <- c(test_code = "Test Code ID",
                     editor = "Editor",
                     editDate = "Edit Date")
@@ -210,9 +213,12 @@ vt_kable_test_code_editors <- function(x,format = vt_render_to()){
 
   t <- kable(x[, names(all_colnames)],
              format = format, booktabs = FALSE,
-             col.names = all_colnames)
+             longtable =  TRUE,
+             col.names = all_colnames
+             )
   t <- column_spec(t, 1, border_left = TRUE)
   t <- column_spec(t, ncol(x), border_right = TRUE)
-  t <- kable_styling(t, latex_options = "hold_position")
+  t <- kable_styling(t, latex_options = latex_options)
+  t <- collapse_rows(t, c(2, 3), ...)
   t
 }