Skip to content

Instantly share code, notes, and snippets.

@debruine
Last active March 15, 2022 14:51
Show Gist options
  • Save debruine/822899cbeebf3ed7bf2beea967537d62 to your computer and use it in GitHub Desktop.
Save debruine/822899cbeebf3ed7bf2beea967537d62 to your computer and use it in GitHub Desktop.
Make crosstabs and add margin totals (or means); a tidyverse-friendly version of base::table()
#' Crosstabs with margins
#'
#' @param data Data frame or tibble
#' @param row Column name (string or index) for rows
#' @param col Column name (string or index) for columns
#' @param margin_func Margin function (e.g., sum, mean, median)
#' @param margin_label Label for margin column and row
#' @param col_prefix Prefix for columns (defaults to col name), set to FALSE to omit; If return == "kable", this is used for the grouping header
#' @param return Return a tibble or formatted kableExtra table
#' @param ... Arguments to pass to kableExtra::kable()
#'
#' @return tibble or kableExtra table
#' @export
#'
#' @examples
#' margintable(mtcars, "cyl", "vs")
#' margintable(mtcars, 2, 8)
#' margintable(mtcars, "vs", "cyl", col_prefix = FALSE)
#' margintable(mtcars, "vs", "cyl", mean, "Mean")
#' margintable(mtcars, "vs", "cyl", col_prefix = "Number of cylinders", return = "kable")
#' margintable(mtcars, "vs", "cyl", col_prefix = FALSE, return = "kable", format = "latex")
margintable <- function(data, row, col,
margin_func = sum,
margin_label = "Total",
col_prefix = col,
return = c("tibble", "kable"),
...) {
# convert numeric specification to names
if (is.numeric(row)) row <- names(data)[[row]]
if (is.numeric(col)) col <- names(data)[[col]]
mt <- data %>%
dplyr::count(.data[[row]], .data[[col]]) %>%
tidyr::pivot_wider(names_from = dplyr::all_of(row),
values_from = n,
values_fill = 0) %>%
dplyr::rowwise(dplyr::all_of(col)) %>%
dplyr::mutate(!!margin_label :=
margin_func(dplyr::c_across())) %>%
tidyr::pivot_longer(cols = -dplyr::all_of(col),
names_to = row,
values_to = "n") %>%
tidyr::pivot_wider(names_from = dplyr::all_of(col),
values_from = n) %>%
dplyr::rowwise(dplyr::all_of(row)) %>%
dplyr::mutate(!!margin_label :=
margin_func(dplyr::c_across()))
if (match.arg(return) == "tibble") {
# optionally add column prefix
if (!isFALSE(col_prefix)) {
mt <- mt %>%
dplyr::rename_with(.fn = ~paste0(col_prefix, "_", .x),
.cols = -c(1, ncol(.)))
}
return(mt)
} else {
headers <- setNames(object = c(1, ncol(mt)-2, 1),
nm = c(" ", col_prefix, " "))
kt <- kableExtra::kable(mt, ...)
if (!isFALSE(col_prefix)) {
kt <- kt %>% kableExtra::add_header_above(headers)
}
return(kt)
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment