group_grid_row

R/tt_grid.R

@@ -84,7 +84,24 @@ empty_cells <- function(lst) {
 }
 
 
-group_grid <- function(x, j, ...) {
+group_grid <- function(x, i = NULL, j = NULL, ...) {
+  out <- x
+
+  if (!is.null(i)) {
+    out <- group_grid_row(out, i)
+  }
+
+  if (!is.null(j)) {
+    out <- group_grid_col(out, j)
+  }
+
+  return(out)
+}
+
+
+group_grid_col <- function(x, j, ...) {
+
+  # columns
   header <- empty_cells(j)
   cw <- meta(x, "col_widths")
   cw <- sapply(header, function(k) sum(cw[k]) + length(cw[k]) - 1)
@@ -101,12 +118,37 @@ group_grid <- function(x, j, ...) {
 }
 
 
-df <- data.frame(
-  Fruit = c("Bananas", "Oranges"),
-  Price = c("$1.34", "$2.10"),
-  Features = c(2, 4.3),
-  Color = c("Yellow", "Orange"),
-  Smell = c("Bad", "Good")
-)
+
+group_grid_row <- function(x, i, ...) {
+  out <- x
+  out <- strsplit(x, split = "\\n")[[1]]
+  # header
+  body_min <- utils::head(grep("^\\+==", out), 1) + 1
+  # no header
+  if (is.na(body_min)) {
+    body_min <- utils::head(grep("^\\+--", out), 1) + 1
+  }
+  body_max <- utils::tail(grep("^\\+--", out), 1) - 1
+  body <- body_min:body_max
+  top <- out[1:(min(body) - 1)]
+  mid <- out[min(body):max(body)]
+  bot <- out[(max(body) + 1):length(out)]
+
+  cw <- meta(x, "col_widths")
+  cw <- sum(cw) + length(cw) - 1
+  for (idx in rev(seq_along(i))) {
+    tmp = trimws(as.character(tt_grid(matrix(names(i)[idx]), col_widths = cw)))
+    mid <- c(mid[1:(i[idx] - 1)], tmp, mid[i[idx]:length(body)]) 
+  }
+
+  out <- c(top, mid, bot)
+  out <- paste(out, collapse = "\n")
+
+  attr(out, "tinytable_meta") <- meta(x)
+  class(out) <- class(x)
+
+  return(out)
+}
+
 
 

inst/tinytest/_tinysnapshot/markdown-group_tt.txt

@@ -0,0 +1,22 @@
+
++------+-------------+------------+
+|      | Foo         | Bar        |
++------+-----+-------+-----+------+
+| mpg  | cyl | disp  | hp  | drat |
++======+=====+=======+=====+======+
+| 21   | 6   | 160   | 110 | 3.9  |
+| 21   | 6   | 160   | 110 | 3.9  |
++---------------------------------+
+| Hello                           |
++---------------------------------+
+| 22.8 | 4   | 108   | 93  | 3.85 |
+| 21.4 | 6   | 258   | 110 | 3.08 |
+| 18.7 | 8   | 360   | 175 | 3.15 |
+| 18.1 | 6   | 225   | 105 | 2.76 |
+| 14.3 | 8   | 360   | 245 | 3.21 |
++---------------------------------+
+| World                           |
++---------------------------------+
+| 24.4 | 4   | 146.7 | 62  | 3.69 |
+| 22.8 | 4   | 140.8 | 95  | 3.92 |
++------+-----+-------+-----+------+

inst/tinytest/test-markdown.R

@@ -9,5 +9,16 @@ expect_snapshot_print(
   tt(k), label = "markdown-nocolnames")
 
 
+tab <- tt(mtcars[1:10, 1:5]) |>
+    group_tt(
+      i = list(
+        "Hello" = 3,
+        "World" = 8),
+      j = list(
+        "Foo" = 2:3,
+        "Bar" = 4:5))
+
+expect_snapshot_print(tab, label = "markdown-group_tt")
+
 
 options(tinytable_print_output = NULL)

vignettes/tutorial.qmd

@@ -72,14 +72,26 @@ tt(x) |> save_tt("path/to/file.md")
 `save_tt()` can also return a string with the table in it, for further processing in `R`. In the first case, the table is printed to console with `cat()`. In the second case, it returns as a single string as an `R` object.
 
 ```{r}
-tt(x) |>
-  group_tt(j = list("Hello" = 2:3, "World" = 4:5)) |>
+tt(mtcars[1:10, 1:5]) |>
+  group_tt(
+    i = list(
+      "Hello" = 3,
+      "World" = 8),
+    j = list(
+      "Foo" = 2:3,
+      "Bar" = 4:5)) |>
   print("markdown")
 ```
 
 ```{r}
-tt(x) |>
-  group_tt(j = list("Hello" = 2:3, "World" = 4:5)) |>
+tt(mtcars[1:10, 1:5]) |>
+  group_tt(
+    i = list(
+      "Hello" = 3,
+      "World" = 8),
+    j = list(
+      "Foo" = 2:3,
+      "Bar" = 4:5)) |>
   save_tt("markdown")
 ```