diff --git a/R/group_grid.R b/R/group_grid.R new file mode 100644 index 00000000..f3e8520a --- /dev/null +++ b/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) +} + diff --git a/R/tt_grid.R b/R/tt_grid.R index 0ee63279..5ddfe226 100755 --- a/R/tt_grid.R +++ b/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) diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_01.txt b/inst/tinytest/_tinysnapshot/docx-issue98_01.txt new file mode 100644 index 00000000..3a680442 --- /dev/null +++ b/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 | ++------+-----+------+-----+------+ diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_02.txt b/inst/tinytest/_tinysnapshot/docx-issue98_02.txt new file mode 100644 index 00000000..9ec9a37c --- /dev/null +++ b/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 | ++----------+-----+------+-----+------+ + diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_03.txt b/inst/tinytest/_tinysnapshot/docx-issue98_03.txt new file mode 100644 index 00000000..4557aed5 --- /dev/null +++ b/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 | ++----------+-----+------+-----+------+ + diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_04.txt b/inst/tinytest/_tinysnapshot/docx-issue98_04.txt new file mode 100644 index 00000000..5e78a7fa --- /dev/null +++ b/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 | ++----------+-----+------+-----+------+ + diff --git a/inst/tinytest/test-docx.R b/inst/tinytest/test-docx.R new file mode 100644 index 00000000..dec24ae5 --- /dev/null +++ b/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) \ No newline at end of file