meta refactor works

R/group_bootstrap.R

@@ -1,9 +1,12 @@
 
 group_bootstrap <- function(x, i, j, indent = 1, ...) {
+  out <- x
+  # columns first to count headers properly
+  if (!is.null(j)) {
+    out <- group_bootstrap_col(out, i = i, j = j, ...)
+  }
   if (!is.null(i)) {
-    out <- group_bootstrap_row(x, i = i, j = j, indent = indent, ...)
-  } else {
-    out <- group_bootstrap_col(x, i = i, j = j, ...)
+    out <- group_bootstrap_row(out, i = i, j = j, indent = indent, ...)
   }
   return(out)
 }

R/group_tabularray.R

@@ -1,9 +1,12 @@
 group_tabularray <- function(x, i, j, indent, ...) {
-  if (!is.null(i)) {
-    out <- group_tabularray_row(x, i, indent, ...)
-  } else {
-    out <- group_tabularray_col(x, j, ...)
+  out <- x
+  # columns first to count headers properly
+  if (!is.null(j)) {
+    out <- group_tabularray_col(out, j, ...)
   }
+  if (!is.null(i)) {
+    out <- group_tabularray_row(out, i, indent, ...)
+  } 
   return(out)
 }
 
@@ -37,13 +40,16 @@ group_tabularray_col <- function(x, j, ...) {
            out[(idx + 1):length(out)])
   out <- paste(out, collapse = "\n")
 
+  # rebuild including meta before style_tt
   class(out) <- class(x)
+  attr(out, "tinytable_meta") <- m
 
   for (k in seq_along(j)) {
     z <- min(j[[k]])
-    idx <- 1 - m$nhead
     args <- list(x = out,
-                 i = idx,
+                 # the new header is always first row and 
+                 # style_tt always adds nhead to index
+                 i = 1 - meta(out)$nhead,
                  j = z,
                  colspan = max(j[[k]]) - min(j[[k]]) + 1)
     if (!"halign" %in% names(dots)) {

R/group_tt.R

@@ -5,37 +5,30 @@
 #' @inheritParams style_tt
 #' @param indent integer number of `pt` to use when indenting the non-labelled rows.
 #' @param ... All additional arguments (ex: `italic`, `bold`, `color`) are automatically passed to the `style_tt()` function and applied to the labels.
-group_tt <- function(x, i, j, indent = 1, ...) {
+group_tt <- function(x, i = NULL, j = NULL, indent = 1, ...) {
 
-  # sanity x
-  m <- meta(x)
-  if (is.null(m)) stop("`x` must be generated by `tinytable::tt()`.", call. = FALSE)
-  if (!isTRUE(m$output %in% c("html", "latex"))) return(x)
+  if (is.null(meta(x))) stop("`x` must be generated by `tinytable::tt()`.", call. = FALSE)
+  if (!isTRUE(meta(x, "output") %in% c("html", "latex"))) return(x)
+  if (is.null(i) && is.null(j)) stop("At least one of `i` or `j` must be specified.", call. = FALSE)
+  assert_integerish(indent, lower = 0)
 
   out <- x
 
-  assert_integerish(indent, lower = 1)
-  if ((missing(i) && missing(j)) || (!missing(i) && !missing(j))) {
-    stop("One and only one of `i` or `j` must be specified.", call. = FALSE)
-  }
-
-  if (missing(i)) i <- NULL
-  if (missing(j)) j <- NULL
-
   i <- sanitize_group_index(i, hi = attr(x, "nrow") + 1, orientation = "row")
   j <- sanitize_group_index(j, hi = attr(x, "ncol"), orientation = "column")
 
+  if (!is.null(i)) out <- meta(out, "nrows", meta(out, "nrows") + length(i))
+  if (!is.null(j)) out <- meta(out, "nhead", meta(out, "nhead") + 1)
+
   # we don't need this as a list, and we use some sorting later
   i <- unlist(i)
 
-  if (m$output == "latex") {
+  if (meta(out)$output == "latex") {
     out <- group_tabularray(out, i = i, j = j, indent = indent, ...)
-  } else if (m$output == "html") {
+  } else if (meta(out)$output == "html") {
     out <- group_bootstrap(out, i = i, j = j, indent = indent, ...)
   }
 
-  if (is.list(j)) attr(out, "nhead") <- attr(out, "nhead") + 1
-
   return(out)
 }
 

R/style_tt.R

@@ -83,7 +83,11 @@ style_tt <- function (x,
     bootstrap_css_rule = bootstrap_css_rule
   )
 
+
   if (!is.null(colspan)) {
+    if (m$output == "html") {
+      warning("`colspan` is not available for HTML tables yet. You can follow progress here: https://github.com/vincentarelbundock/tinytable/issues/43", call. = FALSE )
+    }
     if (is.null(j) || is.null(i) || (!is.null(i) && length(ival) != 1) || (!is.null(j) && length(jval) != 1)) {
       stop("`i` and `j` must be of length 1 when using `colspan`.", call. = FALSE)
     }
@@ -271,7 +275,7 @@ assert_style_tt <- function (x,
 
   m <- meta(x)
 
-  assert_integerish(ival, lower = 0, upper = m$nrows, name = "i")
+  assert_integerish(ival, lower = 1 - m$nhead, upper = m$nrows, name = "i")
   assert_integerish(jval, lower = 1, upper = m$ncols, name = "j")
   assert_string(width, null.ok = TRUE)
   assert_choice(align, c("c", "l", "r"), null.ok = TRUE)

vignettes/tutorial.qmd

@@ -154,7 +154,7 @@ Be aware that this more approach may not work well in Quarto or Rmarkdown docume
 
 ## Footnotes
 
-The `note` argument accepts single strings or named lists of strings:
+The `notes` argument accepts single strings or named lists of strings:
 
 ```{r}
 #| tbl-cap: "A full-width table with wrapped text in cells and a footnote."
@@ -163,7 +163,7 @@ n <- "Fusce id ipsum consequat ante pellentesque iaculis eu a ipsum. Mauris id e
 tt(lorem, notes = n, width = 1)
 ```
 
-When `note` is a named list, the names are used as identifiers and displayed as superscripts:
+When `notes` is a named list, the names are used as identifiers and displayed as superscripts:
 
 ```{r}
 tt(x, notes = list(a = "Blah.", b = "Blah blah."))
@@ -444,6 +444,20 @@ tt(dat) |>
 
 As above, we can pass additional styling options to the `style_tt()` function automatically via `...`. This means that all the arguments like `italic`, `bold`, `color` and friends can be used to style spanning column headers:
 
+```{r}
+dat <- mtcars[1:9, 1:8]
+tt(dat) |> 
+  group_tt(color = "teal", italic = TRUE,
+    j = list("Hamburgers" = 1:3,
+             "Halloumi" = 4:5,
+             "Tofu" = 7),
+    i = list("I like (fake) hamburgers" = 3,
+             "She prefers halloumi" = 4,
+             "They love tofu" = 7))
+```
+
+Or call twice for different stylings for row and column groups:
+
 ```{r}
 dat <- mtcars[1:9, 1:8]
 tt(dat) |>