Nothing
#' Create 2 x k frequency tables
#'
#' Helper function for creating 2 x k frequency tables.
#'
#' @param df a dataframe with binary variable y and categorical variable x or a 2 x k frequency table/matrix. If a table or matrix, x and y must be NULL. Used to select method.
#' @param ... further arguments passed to or from other methods.
#'
#' @return
#' \item{tab}{2 x k frequency table}
#'
#' @examples
#' trial <- data.frame(disease = c(rep("yes", 2), rep("no", 2)),
#' treatment = c(rep(c("estrogen", "placebo"), 2)),
#' count = c(751, 623, 7755, 7479))
#'
#' tavolo(trial, treatment, disease, count)
#'
#' @export
tavolo <- function(df, ...) UseMethod("tavolo")
#' @export
tavolo.default <- function(df, ...) {
x <- df
rev <- list(...)
if (rev["rev"] == "neither") x <- x
else if (rev["rev"] == "rows") x <- x[2L:1L, ]
else if (rev["rev"] == "columns") x <- x[, 2L:1L]
else if (rev["rev"] == "both") x <- x[2L:1L, 2L:1L]
return(x)
}
#' Create 2 x k frequency tables
#'
#' Helper function for creating 2 x k frequency tables.
#'
#' @param df a dataframe with binary variable y and categorical variable x.
#' @param x categorical predictor/exposure, vector.
#' @param y binary outcome, vector.
#' @param weight an optional vector of count weights.
#' @param rev character string indicating whether to switch row or column order, possible options are "neither", "rows", "columns", or "both". The default is "neither".
#' @param ... further arguments passed to or from other methods.
#'
#' @return
#' \item{tab}{2 x k frequency table}
#' @export
#'
#' @examples
#' trial <- data.frame(disease = c(rep("yes", 2), rep("no", 2)),
#' treatment = c(rep(c("estrogen", "placebo"), 2)),
#' count = c(751, 623, 7755, 7479))
#'
#' tavolo(trial, treatment, disease, count)
tavolo.data.frame <- function(df, x, y, weight = NULL,
rev = c("neither", "rows", "columns", "both"), ...) {
pred <- rlang::enexpr(x)
outc <- rlang::enexpr(y)
weight <- rlang::enexpr(weight)
rev <- match.arg(rev)
if (is.null(weight)) {
x <- xtabs(~ df[[pred]] + df[[outc]])
} else {
x <- xtabs(df[[weight]] ~ df[[pred]] + df[[outc]])
}
dnn <- c(pred, outc)
names(dimnames(x)) <- dnn
tavolo.default(df = x, rev = rev)
}
#' Create 2 x k frequency tables
#'
#' Helper function for creating 2 x k frequency tables.
#'
#' @param df a 2 x k frequency matrix.
#' @param dnn optional character vector of dimension names.
#' @param rev character string indicating whether to switch row or column order, possible options are "neither", "rows", "columns", or "both". The default is "neither".
#' @param ... further arguments passed to or from other methods.
#'
#' @return
#' \item{tab}{2 x k frequency table}
#' @export
#'
#' @examples
#' tavolo(matrix(c(23, 45, 67, 12), nrow = 2, ncol = 2), rev = "both")
tavolo.matrix <- function(df, dnn = NULL, rev = c("neither", "rows", "columns", "both"), ...) {
x <- df
rev <- match.arg(rev)
rname <- c("Exposed", "Unexposed")
cname <- c("Outcome", "No Outcome")
if (is.null(dnn)) dimnames(x) <- list(Exposure = rname, Outcome = cname)
else {
dimnames(x) <- list(rname, cname)
names(dimnames(x)) <- dnn
}
tavolo.default(df = x, rev = rev)
}
#' Create 2 x k frequency tables
#'
#' Helper function for creating 2 x k frequency tables.
#'
#' @param df a 2 x k frequency table.
#' @param rev character string indicating whether to switch row or column order, possible options are "neither", "rows", "columns", or "both". The default is "neither".
#' @param ... further arguments passed to or from other methods.
#'
#' @return
#' \item{tab}{2 x k frequency table}
#' @export
#'
#' @examples
#' trial <- data.frame(disease = c(rep("yes", 3), rep("no", 3)),
#' treatment = rep(c("estrogen", "placebo", "other"), 2),
#' count = c(751, 623, 7755, 7479, 9000, 456))
#'
#' xtabs(count ~ treatment + disease, data = trial) %>% tavolo(rev = "columns")
tavolo.table <- function(df, rev = c("neither", "rows", "columns", "both"), ...) {
x <- df
rev <- match.arg(rev)
tavolo.default(df = x, rev = rev)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.