add collapse_rows_latex
diff --git a/R/collapse_rows.R b/R/collapse_rows.R
index 0572976..a4293e6 100644
--- a/R/collapse_rows.R
+++ b/R/collapse_rows.R
@@ -1,10 +1,11 @@
#' Collapse repeat rows to multirow cell
#'
#' @description Experimenting. Don't use it in production.
-collapse_rows <- function(kable_input, columns) {
- if (is.null(columns)) {
- stop("Please specify numeric positions of columns you want to collapse.")
- }
+#' @export
+collapse_rows <- function(kable_input, columns = NULL) {
+ # if (is.null(columns)) {
+ # stop("Please specify numeric positions of columns you want to collapse.")
+ # }
kable_format <- attr(kable_input, "format")
if (!kable_format %in% c("html", "latex")) {
message("Currently generic markdown table using pandoc is not supported.")
@@ -24,6 +25,9 @@
kable_tbody <- xml_tpart(kable_xml, "tbody")
kable_dt <- rvest::html_table(xml2::read_html(as.character(kable_input)))[[1]]
+ if (is.null(columns)) {
+ columns <- seq(1, ncol(kable_dt))
+ }
kable_dt$row_id <- rownames(kable_dt)
collapse_matrix <- collapse_row_matrix(kable_dt, columns)
@@ -57,25 +61,75 @@
return(out)
}
+collapse_row_matrix <- function(kable_dt, columns, html = T) {
+ if (html) {
+ column_block <- function(x) c(x, rep(0, x - 1))
+ } else {
+ column_block <- function(x) c(rep(0, x - 1), x)
+ }
+ mapping_matrix <- list()
+ for (i in columns) {
+ mapping_matrix[[paste0("x", i)]] <- unlist(lapply(
+ rle(kable_dt[, i])$length, column_block))
+ }
+ mapping_matrix <- data.frame(mapping_matrix)
+ return(mapping_matrix)
+}
+
collapse_rows_latex <- function(kable_input, columns) {
- # table_info <- magic_mirror(kable_input)
- # target_row <- table_info$contents[row + 1]
- # new_row <- latex_row_cells(target_row)
- # if (bold) {
- # new_row <- lapply(new_row, function(x) {
- # paste0("\\\\bfseries{", x, "}")
- # })
- # }
- # if (italic) {
- # new_row <- lapply(new_row, function(x) {
- # paste0("\\\\em{", x, "}")
- # })
- # }
- # new_row <- paste(unlist(new_row), collapse = " & ")
- #
- # out <- sub(target_row, new_row, as.character(kable_input), perl = T)
- # out <- structure(out, format = "latex", class = "knitr_kable")
- # attr(out, "kable_meta") <- table_info
- # return(out)
- kable_input
+ table_info <- magic_mirror(kable_input)
+ if (is.null(columns)) {
+ columns <- seq(1, table_info$ncol)
+ }
+ if (!table_info$booktabs) {
+ warning("add_header_left only supports LaTeX table with booktabs. Please",
+ " use kable(..., booktabs = T) in your kable function.")
+ }
+ out <- as.character(kable_input)
+ contents <- table_info$contents
+ kable_dt <- kable_dt_latex(contents)
+ collapse_matrix <- collapse_row_matrix(kable_dt, columns, html = F)
+
+ new_kable_dt <- kable_dt
+ new_contents <- c()
+ for (j in seq(1:ncol(collapse_matrix))) {
+ column_align <- table_info$align_vector_origin[columns[j]]
+ column_width <- ifelse(
+ is.null(table_info$column_width[[paste0("column_", columns[j])]]),
+ "*", table_info$column_width[paste0("column_", columns[j])])
+ for (i in seq(1:nrow(collapse_matrix))) {
+ new_kable_dt[i, j] <- collapse_new_dt_item(
+ kable_dt[i, j], collapse_matrix[i, j], column_width, align = column_align
+ )
+ }
+ }
+ for (i in seq(1:nrow(collapse_matrix))) {
+ new_contents[i] <- paste0(new_kable_dt[i, ], collapse = " & ")
+ out <- sub(contents[i + 1], new_contents[i], out)
+ }
+
+ out <- structure(out, format = "latex", class = "knitr_kable")
+ table_info$collapse_rows <- TRUE
+ attr(out, "kable_meta") <- table_info
+ return(out)
+}
+
+kable_dt_latex <- function(x) {
+ data.frame(do.call(rbind, str_split(x[-1], " & ")), stringsAsFactors = FALSE)
+}
+
+collapse_new_dt_item <- function(x, span, width = NULL, align) {
+ if (span == 0) return("")
+ if (span == 1) return(x)
+ out <- paste0(
+ "\\\\multirow\\{", -span, "\\}\\{",
+ ifelse(is.null(width), "\\*", width),
+ "\\}\\{",
+ switch(align,
+ "l" = "\\\\raggedright\\\\arraybackslash ",
+ "c" = "\\\\centering\\\\arraybackslash ",
+ "r" = "\\\\raggedleft\\\\arraybackslash "),
+ x, "\\}"
+ )
+ return(out)
}
diff --git a/R/column_spec.R b/R/column_spec.R
index 851861a..a177174 100644
--- a/R/column_spec.R
+++ b/R/column_spec.R
@@ -81,6 +81,10 @@
column_spec_latex <- function(kable_input, column, width, bold, italic) {
table_info <- magic_mirror(kable_input)
+ if (!is.null(table_info$collapse_rows)) {
+ message("Usually it is recommended to use column_spec before collapse_rows,",
+ " especially in LaTeX, to get a desired result. ")
+ }
align_collapse <- ifelse(table_info$booktabs, "", "\\|")
kable_align_old <- paste(table_info$align_vector, collapse = align_collapse)
@@ -92,6 +96,12 @@
out <- sub(kable_align_old, kable_align_new, as.character(kable_input),
perl = T)
out <- structure(out, format = "latex", class = "knitr_kable")
+ if (!is.null(width)) {
+ if (is.null(table_info$column_width)) {
+ table_info$column_width <- list()
+ }
+ table_info$column_width[[paste0("column_", column)]] <- width
+ }
attr(out, "kable_meta") <- table_info
return(out)
}
diff --git a/R/kable_styling.R b/R/kable_styling.R
index 71a3074..385b96f 100644
--- a/R/kable_styling.R
+++ b/R/kable_styling.R
@@ -215,7 +215,6 @@
}
styling_latex_striped <- function(x, table_info) {
- usepackage_latex("xcolor", "table")
# gray!6 is the same as shadecolor ({RGB}{248, 248, 248}) in pdf_document
if (table_info$tabular == "longtable" & !is.na(table_info$caption)) {
row_color <- "\\rowcolors{2}{white}{gray!6}\n"
@@ -328,7 +327,6 @@
if (option == "l") return(styling_latex_position_left(x, table_info))
if (option == "r") return(styling_latex_position_right(x, table_info, F))
}
- usepackage_latex("wrapfig")
size_matrix <- sapply(sapply(table_info$contents, str_split, " & "), nchar)
col_max_length <- apply(size_matrix, 1, max) + 4
if (table_info$table_env) {
diff --git a/R/magic_mirror.R b/R/magic_mirror.R
index 9a05fc5..ade1472 100644
--- a/R/magic_mirror.R
+++ b/R/magic_mirror.R
@@ -44,6 +44,7 @@
kable_input, paste0("\\\\begin\\{",
kable_info$tabular,"\\}.*\\{(.*?)\\}"))[2])
kable_info$align_vector <- unlist(strsplit(kable_info$align, ""))
+ kable_info$align_vector_origin <- kable_info$align_vector
# valign
kable_info$valign <- gsub("\\|", "", str_match(
kable_input, paste0("\\\\begin\\{", kable_info$tabular,"\\}(.*)\\{.*?\\}"))[2])
diff --git a/R/util.R b/R/util.R
index 802a56a..e576ef4 100644
--- a/R/util.R
+++ b/R/util.R
@@ -56,18 +56,6 @@
strsplit(x, " \\& ")
}
-collapse_row_matrix <- function(kable_dt, columns) {
- mapping_matrix <- list()
- for (i in columns) {
- mapping_matrix[[paste0("x", i)]] <- unlist(lapply(
- rle(kable_dt[, i])$length, function(x) {
- c(x, rep(0, x - 1))
- }))
- }
- mapping_matrix <- data.frame(mapping_matrix)
- return(mapping_matrix)
-}
-
regex_escape <- function(x, double_backslash = FALSE) {
if (double_backslash) {
x <- gsub("\\\\", "\\\\\\\\", x)
diff --git a/R/zzz.R b/R/zzz.R
index 2096511..a03b2d3 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -2,4 +2,8 @@
usepackage_latex("booktabs")
usepackage_latex("longtable")
usepackage_latex("array")
+ usepackage_latex("multirow")
+ usepackage_latex("xcolor", "table")
+ usepackage_latex("wrapfig")
+
}
diff --git a/tests/visual_tests/collapse_rows_pdf.Rmd b/tests/visual_tests/collapse_rows_pdf.Rmd
new file mode 100644
index 0000000..795bbe1
--- /dev/null
+++ b/tests/visual_tests/collapse_rows_pdf.Rmd
@@ -0,0 +1,17 @@
+---
+title: "Untitled"
+output: pdf_document
+---
+
+```{r}
+library(knitr)
+library(kableExtra)
+collapse_rows_dt <- data.frame(C1 = c(rep("aaaaaa aaaaaa", 10), rep("bbbbb bbbbbb", 5)),
+ C2 = c(rep("c", 7), rep("d", 3), rep("c", 2), rep("d", 3)),
+ C3 = 1:15,
+ C4 = sample(c(0,1), 15, replace = TRUE))
+kable(collapse_rows_dt, "latex", align = "c", booktabs = T) %>%
+ kable_styling() %>%
+ column_spec(1, bold=T, width = "2em") %>%
+ collapse_rows(1:2)
+```