Vectorize colwidths

NEWS.md

@@ -1,5 +1,7 @@
 # tidytlg 0.11.0.9000
 
+- `gentlg()` argument `wcol` now allows for a list of column width vectors when `huxme` is a list of tables.
+
 # tidytlg 0.11.0
 
 - Fixed RTF landscape tag (#54).

R/gentlg.R

@@ -34,9 +34,12 @@
 #' cm for figure outputs. (Default = 6)
 #' @param plotheight (optional) Numerical value that indicates the plot height
 #' in cm for figure outputs. (Default = 5)
-#' @param wcol (optional) Can be a single numerical value that represents the
-#' width of the first column or a vector, specifying the lengths of all columns
-#' in the final table or listing.\cr
+#' @param wcol (optional) Can be one of:
+#' - a single numeric value that represents the width of the first column
+#' - a numeric vector, specifying the widths of all columns in the final table or listing
+#' - a list of numeric vectors (applicable when `huxme` is a list). Each element
+#' can specify the widths of all columns or the width of the first column only\cr
+#'
 #' When a single numerical value is used, this will be taken as the column width
 #' for the first column. The other columns will be equally spaced across the
 #' remainder of the available space. Alternatively, a vector can be used to
@@ -191,6 +194,26 @@
 #'   )
 #' )
 #'
+#' final_2 <- data.frame(
+#'   label = c(
+#'     "Overall", "Safety Analysis Set",
+#'     "Any Adverse event{\\super a}", "- Serious Adverse Event"
+#'   ),
+#'   Drug_A = c("", "40", "10 (25%)", "0"),
+#'   Drug_B = c("", "40", "10 (25%)", "0")
+#' )
+#'
+#' gentlg(
+#'   huxme = list(final_2, final_2),
+#'   wcol = list(c(0.70, 0.15, 0.15), c(0.5)),
+#'   file = "TSFAEX",
+#'   title = "This is Amazing Demonstration 1",
+#'   footers = c(
+#'     "Note: For demonstrative purposes only",
+#'     "{\\super a} Subjects are counted once for any given event."
+#'   )
+#' )
+#'
 #' # Produce output in HTML format
 #' hux <- gentlg(
 #'   huxme = final,
@@ -241,6 +264,21 @@ gentlg <- function(huxme = NULL,
     stopifnot("Each item of `alignments` must be a list" = is.list(alignment))
   }
 
+  # if wcol is a list, then huxme must be a list with same length,
+  # and wcol[[i]] must be a length 1 vector or a vector with as many numeric values
+  # as number of columns in huxme[[i]]
+  if (is.list(wcol)) {
+    assertthat::assert_that(is.list(huxme) && !is.data.frame(huxme),
+                            msg = paste0(
+                              "'wcol' appears to be a list while huxme is not a list of tables/listings. ",
+                              "If you intended 'wcol' to apply to the single output, convert it to a ",
+                              "vector, otherwise pass a non-data.frame list to 'huxme'."
+                            ))
+    ## already know wcol is a list and huxme is a non-data.frame list
+    assertthat::assert_that(length(huxme) == length(wcol),
+                            msg = "Arguments 'wcol' and 'huxme' must have the same length.")
+  }
+
   adjfilename <- stringr::str_replace_all(
     stringr::str_to_lower(file),
     "(-|_)", ""
@@ -332,6 +370,10 @@ gentlg <- function(huxme = NULL,
     alignments <- list(alignments)
   }
 
+  if (!is.list(wcol)) {
+    wcol <- list(wcol)
+  }
+
   hts <- mapply(
     function(ht,
              colspan,
@@ -343,7 +385,8 @@ gentlg <- function(huxme = NULL,
              bottom_borders,
              border_fns,
              alignments,
-             index) {
+             index,
+             wcol) {
       gentlg_single(
         huxme = ht,
         tlf = tlf,
@@ -370,17 +413,18 @@ gentlg <- function(huxme = NULL,
         index_in_result = index
       )
     },
-    huxme,
-    colspan,
-    title,
-    footers,
-    watermark,
-    colheader,
-    pagenum,
-    bottom_borders,
-    border_fns,
-    alignments,
-    seq_len(length(huxme)),
+    ht = huxme,
+    colspan = colspan,
+    title = title,
+    footers = footers,
+    watermark = watermark,
+    colheader = colheader,
+    pagenum = pagenum,
+    bottom_borders = bottom_borders,
+    border_fns = border_fns,
+    alignments = alignments,
+    index = seq_len(length(huxme)),
+    wcol = wcol,
     SIMPLIFY = FALSE
   )
 

inst/WORDLIST

@@ -1,28 +1,5 @@
-<<<<<<< HEAD
-TLG
-TLGs
-tlf
-tidyverse
-Tidyverse
-dataframe
-RTF
-HTML
-SDTM
-PHUSE
-ORCID
-Papadopoulou
-Sheng
-Janssen
-CDISC
-BMI
-JNJ
-jnj
-||||||| 91bb692
-=======
 BMI
 CDISC
-HTML
-JNJ
 Janssen
 ORCID
 PHUSE
@@ -33,15 +10,18 @@ Sheng
 TLG
 TLGs
 Tidyverse
-dataframe
+Timepoint
+Vectorized
+envsetup
+funder
+hardcoded
+huxme
+huxtable
 jnj
+neighbouring
 ppapadop
+preprocessed
 shaesen
 tidyverse
-tlf
-neighbouring
-hardcoded
-funder
-huxtable
-envsetup
->>>>>>> 8341e0b
+vectorized
+wcol

tests/testthat/test-gentlg.R

@@ -1,3 +1,5 @@
+df <- data.frame(label = c("boy", "girl"), name = c("Bob", "Lily"), age = c(12, 15))
+
 test_that("custom alignments work", {
   df <- data.frame(label = c("boy", "girl"), name = c("Bob", "Lily"), age = c(12, 15))
 
@@ -42,3 +44,86 @@ test_that("custom alignments work", {
   expect_equal(align_property_2[4, 2], "center")
   expect_equal(align_property_2[3, 3], "right")
 })
+
+test_that("gentlg() sets the right colwidths when passing a combination of vectors and numeric values", {
+  wcol <- list(c(0.5, 0.3, 0.2), c(0.25))
+  expect_no_error(hux_tables <- gentlg(
+    huxme = list(df, df),
+    wcol = wcol,
+    print.hux = FALSE
+  ))
+
+  for (i in seq_along(wcol)) {
+    ht <- hux_tables[[i]]
+    num_cols <- ncol(ht)
+    actual_colwidths <- as.numeric(huxtable::col_width(ht))
+    if (length(wcol[[i]]) == 1) {
+      expected_colwidths <- c(wcol[[i]], rep((1 - wcol[[i]])/(num_cols - 1), num_cols - 1))
+    } else {
+      expected_colwidths <- wcol[[i]]
+    }
+    expect_equal(actual_colwidths, expected_colwidths)
+  }
+})
+
+test_that("gentlg() sets the right colwidths when passing all colwidths explicitly", {
+  wcol <- list(c(0.5, 0.3, 0.2), c(0.25, 0.5, 0.25))
+  expect_no_error(hux_tables <- gentlg(
+    huxme = list(df, df),
+    wcol = wcol,
+    print.hux = FALSE
+  ))
+
+  for (i in seq_along(wcol)) {
+    ht <- hux_tables[[i]]
+    num_cols <- ncol(ht)
+    expected_colwidths <- wcol[[i]]
+    actual_colwidths <- as.numeric(huxtable::col_width(ht))
+    expect_equal(expected_colwidths, actual_colwidths)
+  }
+})
+
+test_that("gentlg() validates that if hux is a single data.frame, wcol cannot be a list", {
+  wcol <- list(c(0.5), c(0.4, 0.4, 0.2))
+  expect_error(hux_tables <- gentlg(
+    huxme = df,
+    wcol = wcol,
+    print.hux = FALSE
+  ),
+  "\\'wcol\\' appears to be"
+  )
+})
+
+test_that("gentlg() validates each element in wcol has the correct length", {
+  wcol <- list(c(0.5, 0.3), c(0.4, 0.4, 0.2))
+  expect_error(hux_tables <- gentlg(
+    huxme = list(df, df),
+    wcol = wcol,
+    print.hux = FALSE
+  ),
+  "wcol\\'s length must be 1 or the length of final output"
+  )
+})
+
+test_that("gentlg() validates that the sum of colwidths is 1", {
+  wcol <- list(c(0.5, 0.2, 0.5), c(0.4, 0.4, 0.2))
+  expect_error(hux_tables <- gentlg(
+    huxme = list(df, df),
+    wcol = wcol,
+    print.hux = FALSE
+  ),
+  "wcol not defined properly"
+  )
+})
+
+test_that("gentlg() validates hux length equals wcol length if wcol is a list", {
+  wcol <- list(c(0.5), c(0.4, 0.4, 0.2))
+  expect_error(hux_tables <- gentlg(
+    huxme = list(df, df, df),
+    wcol = wcol,
+    print.hux = FALSE
+  ),
+  "Arguments \\'wcol\\' and \\'huxme\\' must have the same length."
+  )
+})
+