#' @title adjust_heights
#' @description Adjust heights of merged rows.
#'
#' @param colnum Column to adjust row heights.
#' @param tgrob tableGrob
#' @param df Dataframe used to obtain row heights.
#'
#' @return Returns adjusted tableGrob.
adjust_heights <- function(colnum, tgrob, df) {
group_var <- names(df)[colnum]
borders <- df %>%
dplyr::ungroup() %>%
dplyr::mutate(row_ind = row_number() + 1) %>%
dplyr::group_by_(group_var) %>%
dplyr::summarise(top = min(row_ind),
bottom = max(row_ind)) %>%
dplyr::arrange(top)
tgrob$layout[tgrob$layout$t != 1 &
tgrob$layout$l == colnum, 't'] <- borders$top
tgrob$layout[tgrob$layout$b != 1 &
tgrob$layout$l == colnum, 'b'] <- borders$bottom
return(tgrob)
}
#' @title merge_rows
#' @description A function to merge equal rows for tableGrob formatting.
#' Assumes n columns that need formatting are first n columns of dataframe.
#'
#' @param df Dataframe to be formatted
#' @param n Number of columns that need merging. Defaults to 1.
#' @param flex Boolean indicating if table is for rmarkdown flexdashboard.
#' Defaults to FALSE
#'
#' @return Returns formatted tableGrob.
#' @export
merge_rows <- function(df, n = 1, flex = FALSE) {
cex <- ifelse(flex, .5, 1)
mytheme <- ttheme_default(
core = list(fg_params = list(cex = cex)),
colhead = list(fg_params = list(cex = cex)),
rowhead = list(fg_params = list(cex = cex))
)
cols <- purrr::map(seq(n), ~.x)
cols[[n+1]] <- (n+1):ncol(df)
cols %<>%
purrr::map(~tableGrob(unique(df[.x]),
row = NULL,
theme = mytheme))
halign <- do.call(gridExtra::combine, c(cols, along = 1))
for(i in seq(n)) {
halign <- adjust_heights(colnum = i, tgrob = halign, df = df)
}
return(halign)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.