merged main

R/add_bottom_borders.R

@@ -223,7 +223,7 @@ should_use_internal_borders <- function(row) {
 #' @param matrix `matrix` of bottom borders. Ignored. Included for the sake
 #' of compatibility with the interface of all border mutating functions.
 #' @export
-#' @family {border functions}
+#' @family border_functions
 no_borders <- function(ht, matrix = NULL) {
   if (is.null(ht)) {
     return(NULL)
@@ -240,7 +240,7 @@ no_borders <- function(ht, matrix = NULL) {
 #'
 #' @param row `numeric` the row of the table
 #' @export
-#' @family {border functions}
+#' @family border_functions
 spanning_borders <- function(row) {
   function(ht, matrix) {
     last_num <- matrix[row][1]
@@ -262,7 +262,7 @@ spanning_borders <- function(row) {
 #' @param col `numeric` the column of the table
 #' @param rows `numeric` the range of rows to include
 #' @export
-#' @family {border functions}
+#' @family border_functions
 col_borders <- function(col, rows) {
   rows <- rows + 1
   function(ht, matrix) {
@@ -278,7 +278,7 @@ col_borders <- function(col, rows) {
 #' @param row `numeric` the row of the cell
 #' @param col `numeric` the column of the cell
 #' @export
-#' @family {border functions}
+#' @family border_functions
 single_border <- function(row, col) {
   function(ht, matrix) {
     border <- 1
@@ -298,7 +298,7 @@ single_border <- function(row, col) {
 #' @param row `numeric` the row of the table
 #' @export
 #'
-#' @family {border functions}
+#' @family border_functions
 row_border <- function(row) {
   function(ht, matrix) {
     matrix[row, ] <- 1

R/gentlg_single.R

@@ -211,6 +211,10 @@ gentlg_single <- function(huxme = NULL,
   ###########################
   ### Formatting values   ###
   ###########################
+
+  if ("newrows" %in% colnames(huxme)) {
+    huxme <- insert_empty_rows(huxme)
+  }
   if ("boldme" %in% colnames(huxme) && length(which(huxme$boldme == 1)) > 0) {
     boldme <- which(huxme$boldme == 1)
   } else {
@@ -264,12 +268,6 @@ gentlg_single <- function(huxme = NULL,
   } else {
     newpage <- NULL
   }
-  if ("newrows" %in% colnames(huxme) &&
-    length(which(huxme$newrows == 1)) > 0) {
-    newrows <- which(huxme$newrows == 1)
-  } else {
-    newrows <- NULL
-  }
 
   # display columns columns only
   if (sum(colnames(huxme) %in% formatcolumns) != 0) {
@@ -709,18 +707,6 @@ gentlg_single <- function(huxme = NULL,
     }
   }
 
-  ### New rows
-  if (!is.null(newrows)) {
-    newrows <- newrows[order(newrows)]
-    newrows <- newrows + formatindex - 1
-    ht2 <- ht[formatindex, ]
-    ht2[1, ] <- ""
-    for (i in seq_along(newrows)) {
-      line <- length(newrows[newrows < newrows[i]]) + newrows[i]
-      ht <- huxtable::add_rows(ht, ht2, after = line)
-    }
-  }
-
   #############################
   ###       Header          ###
   #############################

R/insert_empty_rows.R

@@ -0,0 +1,68 @@
+#' @title Inserts empty rows into a data frame
+#'
+#' @details
+#' `gentlg` allows for formatting the input table based on formatting columns
+#' (see [gentlg()]). One of the formatting mechanisms is empty row insertion. This
+#' function inserts the empty rows based on the `newrows` column in the data
+#' frame. The new rows are inserted before the rows with value `1` in the
+#' `newrows` column.
+#'
+#' @param huxme `data.frame` The input data frame.
+#'
+#' @return A data frame with added new empty rows.
+#' @keywords internal
+insert_empty_rows <- function(huxme, newrows = huxme$newrows) {
+  if (is.null(newrows)) {
+    return(huxme)
+  }
+  assertthat::assert_that(nrow(huxme) == length(newrows))
+
+  format_columns <- c("row_type", "anbr", "indentme", "roworder", "newrows")
+  data_columns <- names(huxme)[!names(huxme) %in% format_columns]
+
+  emptyrow <- huxme[NA, ][1, ]
+  emptyrow[, data_columns] <- ""
+
+  has_roworder <- "roworder" %in% names(huxme)
+  if (has_roworder) {
+    emptyrow[, "roworder"] <- 0
+  }
+  if ("newrows" %in% names(huxme)) {
+    emptyrow$newrows <- 0
+  }
+  if ("row_type" %in% names(huxme)) {
+    emptyrow$row_type <- "EMPTY"
+  }
+  if ("indentme" %in% names(huxme)) {
+    emptyrow[, "indentme"] <- 0
+  }
+  if ("newpage" %in% names(huxme)) {
+    emptyrow[, "newpage"] <- 0
+  }
+
+  cum_sum <- cumsum(newrows)
+  df_chunks <- split(huxme, cum_sum)
+  if ("anbr" %in% names(huxme)) {
+    df_chunks <- lapply(df_chunks, function(chunk) {
+      emptyrow$anbr <- chunk$anbr[1]
+      rbind(chunk, emptyrow)
+    })
+  } else {
+    df_chunks <- lapply(df_chunks, function(chunk) {
+      rbind(chunk, emptyrow)
+    })
+  }
+
+  names(df_chunks) <- NULL
+  merged_df <- do.call(rbind, df_chunks)
+  merged_df <- merged_df[-nrow(merged_df), ]
+  if (has_roworder) {
+    merged_df$roworder <- seq_len(nrow(merged_df))
+  }
+
+  attr(merged_df, "row.names") <- as.integer(seq_len(nrow(merged_df)))
+  if ("newrows" %in% names(huxme)) {
+    merged_df$newrows <- 0
+  }
+  merged_df
+}

R/quick_rtf_jnj.R

@@ -848,7 +848,13 @@ quick_rtf_jnj <- function(hts,
 
   portrait_t <- "{\\rtf1\\ansi\\deff0\\portrait\\paperw12240\\paperh15840\\margl1440\\margr1440\\margt1440\\margb1440\\headery1440\\footery1440{\\stylesheet{\\ql \\li0\\ri0\\widctlpar\\wrapdefault\\faauto\\adjustright\\rin0\\lin0\\itap0 \\rtlch\\fcs1 \\af0\\afs20\\alang1025 \\ltrch\\fcs0 \\fs20\\lang9\\langfe3081\\loch\\f0\\hich\\af0\\dbch\\af31505\\cgrid\\langnp9\\langfenp3081 \\snext0 \\sqformat \\spriority0 Normal;}{\\s15\\ql \\fi-1152\\li1152\\ri0\\keepn\\widctlpar\\tx1152\\wrapdefault\\faauto\\rin0\\lin1152\\itap0 \\rtlch\\fcs1 \\af0\\afs18\\alang1025 \\ltrch\\fcs0 \\b\\fs20\\lang1033\\langfe1033\\loch\\f0\\hich\\af0\\dbch\\af31505\\cgrid\\langnp1033\\langfenp1033 \\sbasedon0 \\snext0 \\sqformat caption;}{\\s16 \\ql \\fi-1152\\li1152\\ri0\\keepn\\widctlpar\\tx1152\\wrapdefault\\faauto\\rin0\\lin1152\\itap0 \\rtlch\\fcs1 \\af0\\afs18\\alang1025 \\ltrch\\fcs0 \\b\\fs20\\lang1033\\langfe1033\\loch\\f0\\hich\\af0\\dbch\\af31505\\cgrid\\langnp1033\\langfenp1033 \\sbasedon0 \\snext0 \\sqformat;}}\n"
   portrait_f <- "{\\rtf1\\ansi\\deff0\\portrait\\paperw15840\\paperh12240\\margl1440\\margr1440\\margt1440\\margb1440\\headery1440\\footery1440{\\stylesheet{\\ql \\li0\\ri0\\widctlpar\\wrapdefault\\faauto\\adjustright\\rin0\\lin0\\itap0 \\rtlch\\fcs1 \\af0\\afs20\\alang1025 \\ltrch\\fcs0 \\fs20\\lang9\\langfe3081\\loch\\f0\\hich\\af0\\dbch\\af31505\\cgrid\\langnp9\\langfenp3081 \\snext0 \\sqformat \\spriority0 Normal;}{\\s15\\ql \\fi-1152\\li1152\\ri0\\keepn\\widctlpar\\tx1152\\wrapdefault\\faauto\\rin0\\lin1152\\itap0 \\rtlch\\fcs1 \\af0\\afs18\\alang1025 \\ltrch\\fcs0 \\b\\fs20\\lang1033\\langfe1033\\loch\\f0\\hich\\af0\\dbch\\af31505\\cgrid\\langnp1033\\langfenp1033 \\sbasedon0 \\snext0 \\sqformat caption;}{\\s16 \\ql \\fi-1152\\li1152\\ri0\\keepn\\widctlpar\\tx1152\\wrapdefault\\faauto\\rin0\\lin1152\\itap0 \\rtlch\\fcs1 \\af0\\afs18\\alang1025 \\ltrch\\fcs0 \\b\\fs20\\lang1033\\langfe1033\\loch\\f0\\hich\\af0\\dbch\\af31505\\cgrid\\langnp1033\\langfenp1033 \\sbasedon0 \\snext0 \\sqformat;}}\n"
-  pagenum_t <- "\\par {\\footer\\pard\\sb240\\qr\\fs16{\\insrsid2691151 Listing Page }{\\field{\\*\\fldinst {\\insrsid2691151 PAGE }}{\\fldrslt {\\insrsid26911511}}}{\\insrsid2691151  of }{\\field{\\*\\fldinst {\\insrsid2691151  NUMPAGES }} {\\fldrslt {\\insrsid112265262}}}{\\insrsid2691151 \\par }}\n\n\n}"
+  pagenum_t <- paste(
+    "\\par {\\footer\\pard\\sb240\\qr\\fs16{\\insrsid2691151 ",
+    ifelse(substr(tolower(tlf), 1, 1) == "t", "Table", "Listing"),
+    " Page }{\\field{\\*\\fldinst {\\insrsid2691151 PAGE }}{\\fldrslt {\\insrsid26911511}}}{\\insrsid2691151  of }{\\field{\\*\\fldinst {\\insrsid2691151  NUMPAGES }} {\\fldrslt {\\insrsid112265262}}}{\\insrsid2691151 \\par }}",
+    collapse = "",
+    sep = ""
+  )
 
   header <- ifelse(portrait, portrait_t, portrait_f)
   rtf_hts <- mapply(