Merge branch 'main' into main

Author: eanokian

.gitignore

@@ -16,7 +16,6 @@ benchmark/*
 /doc/
 /Meta/
 \.DS_Store
-\.lintr
 huxtable-output\.rtf
 docs
 pkgdown/

.lintr

@@ -0,0 +1,13 @@
+linters: linters_with_defaults(
+  line_length_linter = line_length_linter(120L),
+  object_usage_linter = NULL,
+  object_name_linter = object_name_linter(
+    styles = c("snake_case", "symbols"),
+    regexes = c(
+      ANL = "^ANL_?[0-9A-Z_]*$",
+      ADaM = "^r?AD[A-Z]{2,5}_?[0-9]*$",
+      column_names = "^AVAL$|^USUBJID$|^PARAM$|^PARAMCD$"
+    )
+  ),
+  indentation_linter = NULL
+  )

NEWS.md

@@ -1,6 +1,7 @@
 # tidytlg 0.11.0.9000
 
 - Exported functions `get_file_name()` and `insert_empty_rows()`.
+- Updated `gentlg_single()` to replace, in the first column of tables/listings headers, every leading whitespace with 90 twips (0.0625 inches) left-indentation RTF markup.
 
 # tidytlg 0.11.0
 

R/gentlg_single.R

@@ -47,23 +47,23 @@ gentlg_single <- function(huxme = NULL,
       stop("'title_file' file must have columns: 'TABLE ID',
            'IDENTIFIER', and 'TEXT'")
     }
-    title_df <- title_df %>%
+    title_df <- title_df |>
       filter(`TABLE ID` == file)
 
     if (is.null(title) && nrow(title_df) > 0) {
-      title <- title_df %>%
-        filter(str_detect(IDENTIFIER, regex("title", ignore_case = TRUE))) %>%
+      title <- title_df |>
+        filter(str_detect(IDENTIFIER, regex("title", ignore_case = TRUE))) |>
         extract2("TEXT")
       if (length(title) == 0) {
         title <- NULL
       }
     }
     if (is.null(footers) && nrow(title_df) > 0) {
-      footers <- title_df %>%
+      footers <- title_df |>
         filter(str_detect(
           IDENTIFIER,
           regex("^footnote", ignore_case = TRUE)
-        )) %>%
+        )) |>
         extract2("TEXT")
       if (length(footers) == 0) {
         footers <- NULL
@@ -75,21 +75,21 @@ gentlg_single <- function(huxme = NULL,
     cm <- attr(huxme, "column_metadata")
     cm <- cm[, colSums(is.na(cm)) < nrow(cm)]
     if (any(str_detect(names(cm), "span"))) {
-      colspan <- cm %>%
-        select(starts_with("span")) %>%
-        as.list() %>%
+      colspan <- cm |>
+        select(starts_with("span")) |>
+        as.list() |>
         unname()
       colspan <- colspan[!purrr::map_lgl(colspan, ~ all(is.na(.)))]
-      colspan <- purrr::map(colspan, ~ c("", replace_na_with_blank(.))) %>%
+      colspan <- purrr::map(colspan, ~ c("", replace_na_with_blank(.))) |>
         rev()
     }
   }
   if (!is.null(attr(huxme, "column_metadata")) && is.null(colheader)) {
     cm <- attr(huxme, "column_metadata")
     if ("decode" %in% names(cm)) {
-      colheader <- cm %>%
-        select(decode) %>%
-        unlist() %>%
+      colheader <- cm |>
+        select(decode) |>
+        unlist() |>
         unname()
       colheader <- c("", colheader)
       names(colheader) <- c("label", paste0("col", seq_len(nrow(cm))))
@@ -149,7 +149,7 @@ gentlg_single <- function(huxme = NULL,
 
   # Check if the huxme is blank, this will error out in R < 4
   if (ncol(huxme) > 0) {
-    huxme <- huxme %>%
+    huxme <- huxme |>
       select(!c(any_of("func"), ends_with("_ord")))
   }
 
@@ -332,24 +332,24 @@ gentlg_single <- function(huxme = NULL,
   #############################
 
   .to_html <- function(df) {
-    list_df <- df %>%
-      as.list() %>%
+    list_df <- df |>
+      as.list() |>
       lapply(gsub,
         pattern = "(\\{\\\\super)(.*?)(\\})",
         replacement = "<sup>\\2</sup>"
-      ) %>%
+      ) |>
       lapply(gsub,
         pattern = "(\\{\\\\sub)(.*?)(\\})",
         replacement = "<sub>\\2</sub>"
-      ) %>%
-      lapply(gsub, pattern = "\\\\n", replacement = "<br/>") %>%
+      ) |>
+      lapply(gsub, pattern = "\\\\n", replacement = "<br/>") |>
       lapply(gsub, pattern = "\\\\line", replacement = "<br/>")
 
     if (base::inherits(df, "data.frame")) {
-      df <- list_df %>%
+      df <- list_df |>
         data.frame(stringsAsFactors = FALSE, check.names = FALSE)
     } else if (base::inherits(df, "character") && !is.null(df)) {
-      df <- list_df %>%
+      df <- list_df |>
         unlist(use.names = FALSE)
     }
 
@@ -429,7 +429,7 @@ gentlg_single <- function(huxme = NULL,
     }
 
     if (!is.na(idvars[1]) && dim(huxme)[1] >= 1) {
-      for (i in rev(seq_len(length(idvars)))) {
+      for (i in rev(seq_along(idvars))) {
         less <- idvars[1:i]
         huxme[duplicated(huxme[, less]), less] <- ""
       }
@@ -476,9 +476,10 @@ gentlg_single <- function(huxme = NULL,
   #############################
   ###       Huxit!          ###
   #############################
+
   if (is_format_rtf(format)) {
     if (tolower(substr(tlf, 1, 1)) %in% c("t")) {
-      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) %>%
+      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) |>
         huxtable::set_width(value = huxwidth)
       if (ncol(ht) == length(colheader)) {
         ht[1, ] <- colheader
@@ -487,23 +488,25 @@ gentlg_single <- function(huxme = NULL,
           "Column header not used; {length(colheader)} column header provided, but data contain {ncol(ht)} columns"
         )
       }
+      ht[1, 1] <- replace_lead_whitespaces_ind(ht[1, 1])
       ht[1, ] <- paste0("\\keepn\\trhdr ", ht[1, ]) # Make repeated treatments on each page
       formatindex <- 1
     } else if (tolower(substr(tlf, 1, 1)) %in% c("l")) {
-      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) %>%
+      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) |>
         huxtable::set_width(value = huxwidth)
       ht[1, ] <- colheader
+      ht[1, 1] <- replace_lead_whitespaces_ind(ht[1, 1])
       ht[1, ] <- paste0("\\keepn\\trhdr ", ht[1, ]) # Make repeated treatments on each page
       formatindex <- 1
     } else if (tolower(substr(tlf, 1, 1)) %in% c("f", "g")) {
-      ht <- huxtable::as_hux(huxme, add_colnames = FALSE) %>%
+      ht <- huxtable::as_hux(huxme, add_colnames = FALSE) |>
         huxtable::set_width(value = huxwidth)
     } else {
       stop("tlf can have following character values: Table, Listing, Graph, Figure")
     }
   } else if (is_format_html(format)) {
     if (tolower(substr(tlf, 1, 1)) %in% c("t")) {
-      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) %>%
+      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) |>
         huxtable::set_width(value = huxwidth)
       if (ncol(ht) == length(colheader)) {
         ht[1, ] <- colheader
@@ -515,20 +518,20 @@ gentlg_single <- function(huxme = NULL,
 
       formatindex <- 1
     } else if (tolower(substr(tlf, 1, 1)) %in% c("l")) {
-      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) %>%
+      ht <- huxtable::as_hux(huxme, add_colnames = TRUE) |>
         huxtable::set_width(value = huxwidth)
       ht[1, ] <- colheader
       formatindex <- 1
     } else if (tolower(substr(tlf, 1, 1)) %in% c("f", "g")) {
-      ht <- huxtable::as_hux(huxme, add_colnames = FALSE) %>%
+      ht <- huxtable::as_hux(huxme, add_colnames = FALSE) |>
         huxtable::set_width(value = huxwidth)
     } else {
       stop("tlf can have following character values: Table, Listing, Graph, Figure")
     }
   }
 
-  ht <- ht %>%
-    huxtable::set_right_padding(value = getOption("tidytlg.right.padding")) %>%
+  ht <- ht |>
+    huxtable::set_right_padding(value = getOption("tidytlg.right.padding")) |>
     huxtable::set_left_padding(value = getOption("tidytlg.left.padding"))
 
   #############################
@@ -562,15 +565,16 @@ gentlg_single <- function(huxme = NULL,
 
     ### add row one by one to maintain huxtable structure
     if (is_format_rtf(format)) {
-      for (i in rev(seq_len(length(colspan)))) {
+      for (i in rev(seq_along(colspan))) {
+        colspan[[i]][1] <- replace_lead_whitespaces_ind(colspan[[i]][1])
         ht <- huxtable::insert_row(ht, paste0("\\keepn\\trhdr ", colspan[[i]]),
           after = 0, fill = ""
-        ) %>%
+        ) |>
           huxtable::set_number_format(row = 1, col = seq_len(ncol(ht)), value = NA)
       }
     } else if (is_format_html(format)) {
       ### add row one by one to maintain huxtable structure
-      for (i in rev(seq_len(length(colspan)))) {
+      for (i in rev(seq_along(colspan))) {
         ht <- huxtable::insert_row(ht, paste0(colspan[[i]]), after = 0)
       }
     }
@@ -612,10 +616,10 @@ gentlg_single <- function(huxme = NULL,
 
   ### font size
   if ((tolower(substr(tlf, 1, 1)) %in% "l")) {
-    ht <- ht %>%
+    ht <- ht |>
       huxtable::set_font_size(value = getOption("tidytlg.fontsize.listing"))
   } else {
-    ht <- ht %>%
+    ht <- ht |>
       huxtable::set_font_size(value = getOption("tidytlg.fontsize.table"))
   }
 
@@ -874,8 +878,8 @@ gentlg_single <- function(huxme = NULL,
       getOption("tidytlg.fontsize.table")
     ) / 10
 
-    ht <- huxtable::set_top_border(ht, 1, value = bordervalue) %>%
-      huxtable::set_bottom_border(1, value = bordervalue) %>%
+    ht <- huxtable::set_top_border(ht, 1, value = bordervalue) |>
+      huxtable::set_bottom_border(1, value = bordervalue) |>
       huxtable::set_bottom_border(nrow(ht), value = bordervalue)
   } else if (is_format_html(format)) {
     ht[1, ] <- paste0("<div style='border-top :1pt solid; border-bottom :1pt solid; '> ", ht[1, ])
@@ -904,7 +908,7 @@ gentlg_single <- function(huxme = NULL,
           font_size = size, border = 0
         )
       }
-      return(dsnin)
+      dsnin
     }
   } else if (is_format_html(format)) {
     add_footer <- function(dsnin, footer, first = FALSE, size = fontsize) {
@@ -925,7 +929,7 @@ gentlg_single <- function(huxme = NULL,
           font_size = size, border = 0
         )
       }
-      return(dsnin)
+      dsnin
     }
   }
 

R/replace_lead_whitespaces_ind.R

@@ -0,0 +1,29 @@
+#' Replace leading whitespaces with left indentation RTF markup
+#'
+#' @details
+#' The following function receives a string 'x' and returns a modified string
+#' where every leading whitespace is replaced with 90 twips (0.0625 inches) left indentation RTF markup.
+#' If the input does not start with a whitespace, the string is returned as is.
+#'
+#' @param x `character(1)` a string to replace the leading whitespaces.
+#'
+#' @examples
+#' tidytlg:::replace_lead_whitespaces_ind("    this is x")
+#' # [1] "\\intbl\\li360\\fi0 this is x"
+#' tidytlg:::replace_lead_whitespaces_ind("this is x")
+#' # [1] "this is x"
+#'
+#' @return `character(1)` RTF markup with leading whitespaces replaced.
+#' @keywords internal
+replace_lead_whitespaces_ind <- function(x) {
+  # get number of leading whitespaces
+  num_whitespaces <- attr(regexpr("^\\s*", x), "match.length")
+  # 2 whitespaces represent an indentation of 0.125 inches = 180 twips
+  # e.g. 4 whitespaces represent a left-indentation of 0.25 inches = 360 twips
+  num_twips <- num_whitespaces * 90
+  if (num_twips > 0) {
+    raw_rtf_markup <- paste0("\\intbl\\li", num_twips, "\\fi0")
+    x <- paste0(raw_rtf_markup, " ", trimws(x, "left"))
+  }
+  x
+}

inst/WORDLIST

@@ -24,4 +24,5 @@ ppapadop
 preprocessed
 shaesen
 tidyverse
+twips
 vectorized

man/replace_lead_whitespaces_ind.Rd

@@ -56,7 +56,7 @@
 \clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx7367 
 \clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9145 
 \clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx10923 
-\clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx12701 \pard\intbl\ql\fs18 \keepn\trhdr  Standardized medication name \cell
+\clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx12701 \pard\intbl\ql\fs18 \keepn\trhdr \intbl\li90\fi0 Standardized medication name \cell
 \pard\intbl\qc\fs18 \keepn\trhdr N=1 \cell
 \pard\intbl\qc\fs18 \keepn\trhdr N=1 \cell
 \pard\intbl\qc\fs18 \keepn\trhdr N=2 \cell

tests/testthat/_snaps/borders/stubborntest.rtf

@@ -42,3 +42,20 @@ test_that("custom alignments work", {
   expect_equal(align_property_2[4, 2], "center")
   expect_equal(align_property_2[3, 3], "right")
 })
+
+test_that("replace_lead_whitespaces_ind() is replacing whitespaces", {
+  # case when there are 2 leading whitespaces, should insert 180 twips
+  df <- data.frame(label = c("boy", "girl"), name = c("Bob", "Lily"), age = c(12, 15))
+  expect_no_error(res <- gentlg(huxme = df,
+         print.hux = FALSE,
+         colheader = c("  Gender", "Name", "Age")))
+  res <- as.character(res[[1]][2, 1])
+  expect_equal(res, "\\keepn\\trhdr \\intbl\\li180\\fi0 Gender")
+
+  # case when there are no leading whitespaces, should leave it as is
+  expect_no_error(res <- gentlg(huxme = df,
+                                print.hux = FALSE,
+                                colheader = c("Gender", "Name", "Age")))
+  res <- as.character(res[[1]][2, 1])
+  expect_equal(res, "\\keepn\\trhdr Gender")
+})

tests/testthat/test-gentlg.R

@@ -56,7 +56,7 @@
 \clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx7367 
 \clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx9145 
 \clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx10923 
-\clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx12701 \pard\intbl\ql\fs18 \keepn\trhdr  Standardized medication name \cell
+\clbrdrt\clbrdrl\clbrdrb\brdrs\brdrw18\clbrdrr\clvertalb\cellx12701 \pard\intbl\ql\fs18 \keepn\trhdr \intbl\li90\fi0 Standardized medication name \cell
 \pard\intbl\qc\fs18 \keepn\trhdr N=1 \cell
 \pard\intbl\qc\fs18 \keepn\trhdr N=1 \cell
 \pard\intbl\qc\fs18 \keepn\trhdr N=2 \cell