Add a new layout and other features for collapse_rows for LaTeX
- Add `custom` option to latex_hline that fills the gap between the `major` and `full` options
- Add `row_group_label_position` option that can stack multiple layers to avoid the tables being too wide.
- Add `row_group_label_fonts` to format the stacked labels.
diff --git a/R/collapse_rows.R b/R/collapse_rows.R
index ec33c5a..98a6ba2 100644
--- a/R/collapse_rows.R
+++ b/R/collapse_rows.R
@@ -9,7 +9,16 @@
#' @param kable_input Output of `knitr::kable()` with `format` specified
#' @param columns Numeric column positions where rows need to be collapsed.
#' @param latex_hline Option controlling the behavior of adding hlines to table.
-#' Choose from `full`, `major`, `none`.
+#' Choose from `full`, `major`, `none`, `custom`.
+#' @param custom_latex_hline Numeric column positions whose collapsed rows will
+#' be separated by hlines.
+#' @param row_group_label_position Option controlling positions of row group
+#' labels. Choose from `identity`, `stack`.
+#' @param row_group_label_fonts A list of arguments that can be supplied to
+#' group_rows function to format the row group label when
+#' `row_group_label_position` is `stack`
+#' @param headers_to_remove Numeric column positions where headers should be
+#' removed when they are stacked.
#'
#' @examples dt <- data.frame(a = c(1, 1, 2, 2), b = c("a", "a", "a", "b"))
#' x <- knitr::kable(dt, "html")
@@ -17,7 +26,11 @@
#'
#' @export
collapse_rows <- function(kable_input, columns = NULL,
- latex_hline = c("full", "major", "none")) {
+ latex_hline = c("full", "major", "none", "custom"),
+ row_group_label_position = c('identity', 'stack'),
+ custom_latex_hline = NULL,
+ row_group_label_fonts = NULL,
+ headers_to_remove = NULL) {
# if (is.null(columns)) {
# stop("Please specify numeric positions of columns you want to collapse.")
# }
@@ -32,8 +45,12 @@
return(collapse_rows_html(kable_input, columns))
}
if (kable_format == "latex") {
- latex_hline <- match.arg(latex_hline, c("full", "major", "none"))
- return(collapse_rows_latex(kable_input, columns, latex_hline))
+ latex_hline <- match.arg(latex_hline, c("full", "major", "none", "custom"))
+ row_group_label_position <- match.arg(row_group_label_position,
+ c('identity', 'stack'))
+ return(collapse_rows_latex(kable_input, columns, latex_hline,
+ row_group_label_position, row_group_label_fonts, custom_latex_hline,
+ headers_to_remove))
}
}
@@ -96,7 +113,9 @@
return(mapping_matrix)
}
-collapse_rows_latex <- function(kable_input, columns, latex_hline) {
+collapse_rows_latex <- function(kable_input, columns, latex_hline,
+ row_group_label_position, row_group_label_fonts,
+ custom_latex_hline, headers_to_remove) {
table_info <- magic_mirror(kable_input)
out <- enc2utf8(as.character(kable_input))
@@ -106,6 +125,8 @@
contents <- table_info$contents
kable_dt <- kable_dt_latex(contents)
+
+ collapse_matrix_rev <- collapse_row_matrix(kable_dt, columns, html = TRUE)
collapse_matrix <- collapse_row_matrix(kable_dt, columns, html = FALSE)
new_kable_dt <- kable_dt
@@ -115,9 +136,15 @@
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
- )
+ if(row_group_label_position == 'stack'){
+ if(j < ncol(collapse_matrix)|(collapse_matrix_rev[i, j] == 0)){
+ new_kable_dt[i, j] <- ''
+ }
+ } else {
+ new_kable_dt[i, j] <- collapse_new_dt_item(
+ kable_dt[i, j], collapse_matrix[i, j], column_width, align = column_align
+ )
+ }
}
}
@@ -132,6 +159,20 @@
}
new_contents <- c()
+ if(row_group_label_position == 'stack'){
+ if(is.null(headers_to_remove)) headers_to_remove <- head(columns, -1)
+ table_info$colnames[headers_to_remove] <- ''
+ new_header <- paste(table_info$colnames, collapse = ' & ')
+ out <- sub(contents[1], new_header, out)
+ table_info$contents[1] <- new_header
+ }
+ if(latex_hline == 'custom' & is.null(custom_latex_hline)){
+ if(row_group_label_position == 'stack'){
+ custom_latex_hline = 1:2
+ } else {
+ custom_latex_hline = 1
+ }
+ }
for (i in seq(1:nrow(collapse_matrix))) {
new_contents[i] <- paste0(new_kable_dt[i, ], collapse = " & ")
table_info$contents[i + 1] <- new_contents[i]
@@ -146,7 +187,13 @@
midline_groups(which(as.numeric(midrule_matrix[i, ]) > 0),
table_info$booktabs),
""
- )
+ ),
+ "custom" = ifelse(
+ sum(as.numeric(midrule_matrix[i, custom_latex_hline])) > 0,
+ midline_groups(which(as.numeric(midrule_matrix[i, ]) > 0),
+ table_info$booktabs),
+ ""
+ )
)
new_contents[i] <- paste0(new_contents[i], "\\\\\\\\\n", row_midrule)
}
@@ -157,6 +204,10 @@
out <- structure(out, format = "latex", class = "knitr_kable")
table_info$collapse_rows <- TRUE
attr(out, "kable_meta") <- table_info
+ if(row_group_label_position == 'stack'){
+ group_row_index_list <- collapse_rows_index(kable_dt, head(columns, -1))
+ out <- collapse_rows_latex_stack(out, group_row_index_list, row_group_label_fonts)
+ }
return(out)
}
@@ -193,3 +244,52 @@
out <- paste0(out, collapse = "\n")
return(out)
}
+
+
+collapse_rows_index <- function(kable_dt, columns) {
+ format_to_row_index <- function(x){
+ x = rle(x)
+ out = x$lengths
+ names(out) = x$values
+ out
+ }
+ group_rows_index_list <- lapply(columns, function(x) {
+ format_to_row_index(kable_dt[, x])
+ })
+ return(group_rows_index_list)
+}
+
+
+collapse_rows_latex_stack <- function(kable_input, group_row_index_list,
+ row_group_label_fonts){
+ merge_lists <- function(default_list, updated_list){
+ for(x in names(updated_list)){
+ default_list[[x]] <- updated_list[[x]]
+ }
+ return(default_list)
+ }
+ default_font_list <- list(
+ list(bold = T, italic = F),
+ list(bold = F, italic = T),
+ list(bold = F, italic = F)
+ )
+ n_default_fonts = length(default_font_list)
+ n_supplied_fonts = length(row_group_label_fonts)
+ group_row_font_list <- list()
+ out <- kable_input
+ for(i in 1:length(group_row_index_list)){
+ if(i > n_default_fonts){
+ group_row_args <- default_font_list[[n_default_fonts]]
+ } else {
+ group_row_args <- default_font_list[[i]]
+ }
+ if(i <= n_supplied_fonts){
+ group_row_args <- merge_lists(group_row_args, row_group_label_fonts[[i]])
+ }
+ group_row_args <- merge_lists(
+ list(kable_input = out, index = group_row_index_list[[i]]),
+ group_row_args)
+ out <- do.call(group_rows, group_row_args)
+ }
+ return(out)
+}
diff --git a/vignettes/awesome_table_in_pdf.Rmd b/vignettes/awesome_table_in_pdf.Rmd
index fe9e7f6..1112e24 100644
--- a/vignettes/awesome_table_in_pdf.Rmd
+++ b/vignettes/awesome_table_in_pdf.Rmd
@@ -347,6 +347,41 @@
collapse_rows(1:2)
```
+When there are too many layers, sometimes the table can become too wide. You can choose to stack the first few layers by setting `row_group_label_position` to `stack`.
+
+
+```{r}
+collapse_rows_dt <- expand.grid(
+ Country = sprintf('Country with a long name %s', c('A', 'B')),
+ State = sprintf('State %s', c('a', 'b')),
+ City = sprintf('City %s', c('1', '2')),
+ District = sprintf('District %s', c('1', '2'))
+) %>% arrange(Country, State, City) %>%
+ mutate_all(as.character) %>%
+ mutate(C1 = rnorm(n()),
+ C2 = rnorm(n()))
+
+kable(collapse_rows_dt, format = "latex",
+ booktabs = T, align = "c", linesep = '') %>%
+ collapse_rows(1:3, row_group_label_position = 'stack')
+```
+
+To better distinguish different layers, you can format the each layer using `row_group_label_fonts`. You can also customize the hlines to better differentiate groups.
+
+```{r}
+row_group_label_fonts <- list(
+ list(bold = T, italic = T),
+ list(bold = F, italic = F)
+ )
+kable(collapse_rows_dt, format = "latex",
+ booktabs = T, align = "c", linesep = '') %>%
+ column_spec(1, bold=T) %>%
+ collapse_rows(1:3, latex_hline = 'custom', custom_latex_hline = 1:3,
+ row_group_label_position = 'stack',
+ row_group_label_fonts = row_group_label_fonts)
+```
+
+
# Table Footnote
> Now it's recommended to use the new `footnote` function instead of `add_footnote` to make table footnotes.