Issue #98 Bug fix for column alignment in markdown, affecting docx ou…

…tput

R/group_grid.R

@@ -0,0 +1,68 @@
+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, ...) {
+  m <- meta(x)
+  # columns
+  header <- empty_cells(j)
+  cw <- meta(x, "col_widths")
+  cw <- sapply(header, function(k) sum(cw[k]) + length(cw[k]) - 1)
+  txt <- t(matrix(names(cw)))
+  out <- tt_grid(txt, cw)
+  out <- strsplit(out, split = "\\n")[[1]]
+  out <- out[out != "\\n"]
+  out <- out[!out %in% c("\\n", "")]
+  x <- strsplit(x, split = "\\n")[[1]]
+  x <- x[!x %in% c("\\n", "")]
+  out <- out[1:(length(out) - 1)]
+  out <- paste(c(out, x), collapse = "\n")
+  attr(out, "tinytable_meta") <- m
+  class(out) <- class(x)
+  return(out)
+}
+
+
+
+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) || length(body_min) == 0) {
+    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 <- as.character(tt_grid(matrix(names(i)[idx]), col_widths = cw))
+    tmp <- strsplit(tmp, split = "\\n")[[1]][2]
+    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)
+}
+

R/tt_grid.R

@@ -29,10 +29,12 @@ tt_grid <- function(x, col_widths = NULL, ...) {
   col_widths_auto <- NULL
   for (j in 1:ncol(x)) {
     if (is.null(col_widths)) {
-      tab[, j] <- format(tab[, j])
-      col_widths_auto[j] <- nchar(tab[1, j])
+      nc <- nchar(tab[, j])
+      col_widths_auto[j] <- max(nc)
+      tab[, j] <- paste0(tab[, j], strrep(" ", max(nc) - nc))
     } else {
-      tab[, j] <- format(tab[, j], width = col_widths[j])
+      nc <- nchar(tab[, j])
+      tab[, j] <- paste0(tab[, j], strrep(" ", col_widths[j] - nc))
     }
   }
 
@@ -72,6 +74,10 @@ empty_cells <- function(lst) {
   # Find missing numbers (holes)
   missing_nums <- setdiff(full_range, unlist(lst))
 
+  if (length(missing_nums) == 0) {
+    return(lst)
+  }
+
   # Create new elements for missing numbers
   new_elements <- split(missing_nums, cumsum(c(1, diff(missing_nums) != 1)))
 
@@ -84,74 +90,6 @@ empty_cells <- function(lst) {
 }
 
 
-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, ...) {
-  m <- meta(x)
-  # columns
-  header <- empty_cells(j)
-  cw <- meta(x, "col_widths")
-  cw <- sapply(header, function(k) sum(cw[k]) + length(cw[k]) - 1)
-  txt <- t(matrix(names(cw)))
-  out <- tt_grid(txt, cw)
-  out <- strsplit(out, split = "\\n")[[1]]
-  out <- out[out != "\\n"]
-  out <- out[!out %in% c("\\n", "")]
-  x <- strsplit(x, split = "\\n")[[1]]
-  x <- x[!x %in% c("\\n", "")]
-  out <- out[1:(length(out) - 1)]
-  out <- paste(c(out, x), collapse = "\n")
-  attr(out, "tinytable_meta") <- m
-  class(out) <- class(x)
-  return(out)
-}
-
-
-
-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) || length(body_min) == 0) {
-    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)))
-    tmp <- strsplit(tmp, split = "\\n")[[1]][2]
-    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)
-}
-
 
 
 # insert horizontal rules everywhere (important for word)

inst/tinytest/_tinysnapshot/docx-issue98_01.txt

@@ -0,0 +1,14 @@
+
++------+------------+------------+
+|      | a          | b          |
++------+-----+------+-----+------+
+| mpg  | cyl | disp | hp  | drat |
++======+=====+======+=====+======+
+| 21   | 6   | 160  | 110 | 3.9  |
++------+-----+------+-----+------+
+| 21   | 6   | 160  | 110 | 3.9  |
++------+-----+------+-----+------+
+| 22.8 | 4   | 108  | 93  | 3.85 |
++------+-----+------+-----+------+
+| 21.4 | 6   | 258  | 110 | 3.08 |
++------+-----+------+-----+------+

inst/tinytest/_tinysnapshot/docx-issue98_02.txt

@@ -0,0 +1,15 @@
+
+
+
++----------+-----+------+-----+------+
+| mpg      | cyl | disp | hp  | drat |
++==========+=====+======+=====+======+
+| $\sigma$ | 6   | 160  | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 21       | 6   | 160  | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 22.8     | 4   | 108  |  93 | 3.85 |
++----------+-----+------+-----+------+
+| 21.4     | 6   | 258  | 110 | 3.08 |
++----------+-----+------+-----+------+
+

inst/tinytest/_tinysnapshot/docx-issue98_03.txt

@@ -0,0 +1,15 @@
+
+
+
++----------+-----+------+-----+------+
+| $\sigma$ | cyl | disp | hp  | drat |
++==========+=====+======+=====+======+
+| $\sigma$ | 6   | 160  | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 21       | 6   | 160  | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 22.8     | 4   | 108  |  93 | 3.85 |
++----------+-----+------+-----+------+
+| 21.4     | 6   | 258  | 110 | 3.08 |
++----------+-----+------+-----+------+
+

inst/tinytest/_tinysnapshot/docx-issue98_04.txt

@@ -0,0 +1,15 @@
+
+
+
++----------+-----+------+-----+------+
+| $\sigma$ | cyl | disp | hp  | drat |
++==========+=====+======+=====+======+
+| 1        | 6   | 160  | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 21       | 6   | 160  | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 22.8     | 4   | 108  |  93 | 3.85 |
++----------+-----+------+-----+------+
+| 21.4     | 6   | 258  | 110 | 3.08 |
++----------+-----+------+-----+------+
+

inst/tinytest/test-docx.R

@@ -0,0 +1,25 @@
+source("helpers.R")
+using("tinysnapshot")
+options(tinytable_print_output = "markdown")
+
+
+# issue #98: Grid alignment
+x <- mtcars[1:4, 1:5]
+tab <- tt(x) |> group_tt(j = list(a = 2:3, b = 4:5)) 
+expect_snapshot_print(tab, label = "docx-issue98_01")
+
+x[1,1] <- "$\\sigma$"
+expect_snapshot_print(tt(x), label = "docx-issue98_02")
+
+colnames(x)[1] <- "$\\sigma$"
+expect_snapshot_print(tt(x), label = "docx-issue98_03")
+
+x[1,1] <- "1"
+expect_snapshot_print(tt(x), label = "docx-issue98_04")
+
+
+# Issue #98: Math
+# x[1,1] <- "\\(\\sigma\\)"
+# tt(x)
+
+options(tinytable_print_output = NULL)