Nothing
#' Tabulate Frequency Counts for Multiple Vectors
#'
#' \code{mtabulate} - Similar to \code{\link[base]{tabulate}} that works on
#' multiple vectors.
#'
#' @param vects A \code{\link[base]{vector}}, \code{\link[base]{list}}, or
#' \code{\link[base]{data.frame}} of named/unnamed vectors.
#' @keywords tabulate frequency
#' @export
#' @seealso \code{\link[base]{tabulate}}
#' @return \code{mtabulate} - Returns a \code{\link[base]{data.frame}} with
#' columns equal to number of unique elements and the number of rows equal to
#' the the original length of the \code{\link[base]{vector}},
#' \code{\link[base]{list}}, or \code{\link[base]{data.frame}} (length equals
#' number of columns in \code{\link[base]{data.frame}}). If list of vectors is
#' named these will be the rownames of the dataframe.
#' @author Joran Elias and Tyler Rinker <tyler.rinker@@gmail.com>.
#' @rdname mtabulate
#' @references \url{https://stackoverflow.com/a/9961324/1000343}
#' @examples
#' mtabulate(list(w=letters[1:10], x=letters[1:5], z=letters))
#' mtabulate(list(mtcars$cyl[1:10]))
#'
#' ## Dummy coding
#' mtabulate(mtcars$cyl[1:10])
#' mtabulate(CO2[, "Plant"])
#'
#' dat <- data.frame(matrix(sample(c("A", "B"), 30, TRUE), ncol=3))
#' mtabulate(dat)
#' as_list(mtabulate(dat))
#' t(mtabulate(dat))
#' as_list(t(mtabulate(dat)))
mtabulate <- function(vects) {
lev <- sort(unique(unlist(vects)))
dat <- do.call(rbind, lapply(vects, function(x, lev){
tabulate(factor(x, levels = lev, ordered = TRUE),
nbins = length(lev))}, lev = lev))
colnames(dat) <- sort(lev)
data.frame(dat, check.names = FALSE)
}
#' Tabulate Frequency Counts for Multiple Vectors
#'
#' \code{as_list} - Convert a count matrix to a named list of elements. The
#' semantic inverse of \code{mtabulate}.
#'
#' @param mat A matrix of counts.
#' @param nm A character vector of names to assign to the list.
#' @rdname mtabulate
#' @return \code{as_list} - Returns a list of elements.
#' @export
as_list <- function(mat, nm = rownames(mat)) {
nms <- colnames(mat)
lst <- lapply(seq_len(nrow(mat)), function(i) rep(nms, mat[i, , drop =FALSE]))
#if (nrow(mat) == 1) lst <- list(c(lst))
if (!is.list(lst) & is.atomic(lst)) lst <- as.list(lst)
if(!is.list(lst)) lst <- lapply(seq_len(ncol(lst)), function(i) lst[, i])
stats::setNames(lst, nm = nm)
}
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.