#' summary.freqlist
#'
#' Summarize the \code{freqlist} object.
#'
#' @param object an object of class \code{\link{freqlist}}
#' @param ... For \code{summary.freqlist}, these are passed to \code{\link{as.data.frame.freqlist}} (and hence to
#' \code{\link{freq.control}}). For the print method, these are
#' additional arguments passed to the \code{\link[knitr]{kable}} function.
#' @param x An object of class \code{summary.freqlist}.
#' @inheritParams summary.tableby
#' @return An object of class \code{"summary.freqlist"} (invisibly for the print method).
#' @seealso \code{\link{freqlist}}, \code{\link[base]{table}}, \code{\link[stats]{xtabs}}, \code{\link[knitr]{kable}},
#' \code{\link{freq.control}}, \code{\link{freqlist.internal}}
#'
#' @examples
#' # load mockstudy data
#' data(mockstudy)
#' tab.ex <- table(mockstudy[c("arm", "sex", "mdquality.s")], useNA = "ifany")
#' noby <- freqlist(tab.ex, na.options = "include")
#' summary(noby)
#' withby <- freqlist(tab.ex, strata = c("arm","sex"), na.options = "showexclude")
#' summary(withby)
#' summary(withby, dupLabels = TRUE)
#' @author Tina Gunderson, with major revisions by Ethan Heinzen
#' @name summary.freqlist
NULL
#> NULL
#' @rdname summary.freqlist
#' @export
summary.freqlist <- function(object, ..., labelTranslations = NULL, title = NULL)
{
dat <- as.data.frame(object, ..., labelTranslations = labelTranslations, list.ok = TRUE)
structure(list(
object = set_attr(dat, "control", NULL),
control = attr(dat, "control"),
title = title
), class = c("summary.freqlist", "summary.arsenal_table"))
}
as_data_frame_summary_freqlist <- function(tb, labs, cntrl)
{
fmtdups <- function(x, i)
{
x[i] <- lapply(x[i], as.character)
if(nrow(x) == 0) return(x)
tab <- as.matrix(x[i])
tab[is.na(tab)] <- "NA"
num <- max(lengths(gregexpr(",", tab)))
for(col in seq_len(ncol(tab)))
{
tmp <- apply(tab[, 1:col, drop = FALSE], 1, paste, collapse = strrep(",", num + 1))
x[c(FALSE, tmp[-1] == tmp[-length(tmp)]), colnames(tab)[col]] <- ""
}
x
}
fmtdigits <- function(x, digits.count, digits.pct)
{
if(nrow(x) == 0) return(x)
if("Freq" %in% names(x)) x$Freq <- formatC(x$Freq, digits = digits.count, format = "f")
if("cumFreq" %in% names(x)) x$cumFreq <- formatC(x$cumFreq, digits = digits.count, format = "f")
if("freqPercent" %in% names(x)) x$freqPercent <- formatC(x$freqPercent, digits = digits.pct, format = "f")
if("cumPercent" %in% names(x)) x$cumPercent <- formatC(x$cumPercent, digits = digits.pct, format = "f")
x
}
idx <- names(tb) %nin% c("Freq", "cumFreq", "freqPercent", "cumPercent")
tb <- fmtdigits(tb, digits.count = cntrl$digits.count, digits.pct = cntrl$digits.pct)
if(!cntrl$dupLabels) tb <- fmtdups(tb, idx)
tb <- stats::setNames(tb, labs[names(tb)])
set_attr(set_attr(tb, "labels", NULL), "align", c("r", "l")[1 + idx])
}
#' @rdname summary.freqlist
#' @export
as.data.frame.summary.freqlist <- function(x, ..., list.ok = FALSE)
{
out <- Map(x$object, lapply(x$object, attr, "labels"), f = as_data_frame_summary_freqlist, MoreArgs = list(cntrl = x$control))
if(!list.ok)
{
if(length(out) == 1) out <- out[[1]] else warning("as.data.frame.summary.freqlist is returning a list of data.frames")
}
out
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.