Nothing
#' @import assertthat
NULL
#' Create a huxtable
#'
#' `huxtable`, or `hux`, creates a huxtable object.
#'
#' @param ... For `huxtable`, named list of values as in [data.frame()].
#' For `tribble_hux`, data values as in [tibble::tribble()].
#' @param add_colnames If `TRUE`, add a first row of column names to the huxtable.
#' @param add_rownames If `TRUE` or a character string, add a first column of row names
#' to the huxtable. The string gives the name for the new column (or `"rownames"` for `TRUE`).
#' @param autoformat If `TRUE`, automatically format columns by type. See below.
#'
#' @return An object of class `huxtable`.
#' @export
#' @section Automatic formatting:
#'
#' If `autoformat` is `TRUE`, then columns will have [number_format()] and [align()] properties
#' set automatically, as follows:
#'
#' * Integer columns will have `number_format` set to 0.
#' * Other numeric columns will have `number_format` set to \code{"\%.3g"}.
#' * All other columns will have `number_format` set to `NA` (no formatting).
#' * Integer, `Date` and date-time (i.e. `POSIXct` and `POSIXlt`) columns will be right-aligned.
#' * Other numeric columns will be aligned on `options("OutDec")`, usually `"."`.
#' * Other columns will be left aligned.
#'
#' You can change these defaults by editing `options("huxtable.autoformat_number_format")` and
#' `options("huxtable.autoformat_align")`. See [huxtable-package] for more details.
#'
#' Automatic alignment also applies to column headers if `add_colnames` is `TRUE`; headers of
#' columns aligned on a decimal point will be right-aligned. Automatic number formatting does not
#' apply to column headers.
#'
#' @details
#' If you use `add_colnames` or `add_rownames`, be aware that these will shift your rows and columns
#' along by one: your old row/column 1 will now be row/column 2, etc.
#'
#' `add_colnames` defaults to `TRUE`. You can set the default globally by
#' setting `options("huxtable.add_colnames")` to `TRUE` or `FALSE`.
#'
#' @seealso [huxtable-options]
#'
#' @examples
#' ht <- huxtable(
#' column1 = 1:5,
#' column2 = letters[1:5]
#' )
#' ht
huxtable <- function (
...,
add_colnames = getOption("huxtable.add_colnames", TRUE),
add_rownames = FALSE,
autoformat = getOption("huxtable.autoformat", TRUE)
) {
assert_that(
is.flag(add_colnames),
is.flag(add_rownames) | is.string(add_rownames),
is.flag(autoformat)
)
df_args <- list(..., stringsAsFactors = FALSE, check.names = FALSE)
if (R.version$major >= 3 && R.version$minor >= 3) df_args$fix.empty.names <- FALSE
ht <- do.call(data.frame, df_args)
if (is.null(names(list(...))) & ! is.data.frame(..1)) add_colnames <- FALSE
ht <- as_huxtable(ht, add_colnames = add_colnames, add_rownames = add_rownames,
autoformat = autoformat)
ht
}
#' @export
#' @rdname huxtable
hux <- huxtable
#' @export
#' @details
#' `tribble_hux` is a simple wrapper around `tibble::tribble()` which lets you
#' create data in a readable format. It requires the "tibble" package to
#' be installed.
#'
#' @rdname huxtable
#' @examples
#' tribble_hux(
#' ~ Name, ~ Salary,
#' "John Smith", 50000,
#' "Jane Doe", 50000,
#' "David Hugh-Jones", 50000,
#' add_colnames = TRUE
#' )
tribble_hux <- function (...,
add_colnames = getOption("huxtable.add_colnames", TRUE),
autoformat = getOption("huxtable.autoformat", TRUE)
) {
assert_package("tribble_hux", "tibble")
as_hux(tibble::tribble(...), add_colnames = add_colnames, add_rownames = FALSE,
autoformat = autoformat)
}
#' Convert objects to huxtables
#'
#' `as_huxtable` or `as_hux` converts an object to a huxtable.
#' Conversion methods exist for data frames and tibbles, tables,
#' ftables, matrices and (most) vectors.
#'
#' `is_hux[table]` tests if an object is a huxtable.
#'
#' @param x Object to convert.
#' @param ... Arguments passed on to [huxtable()].
#' @inheritParams huxtable
#'
#' @return An object of class "huxtable".
#'
#' @details
#' For `table` objects, `add_colnames` and `add_rownames` are `TRUE` by default. For
#' `matrix` objects, they are `FALSE`. Other classes use
#' `options("huxtable.add_colnames")`, which is `TRUE` by default; `add_rownames`
#' is `FALSE`.
#'
#' For [dplyr::grouped_df()] objects, groups will be converted to header rows
#' if `groups_to_headers` is `TRUE`.
#'
#' @export
#' @examples
#' dfr <- data.frame(
#' a = 1:5,
#' b = letters[1:5],
#' stringsAsFactors = FALSE
#' )
#' as_huxtable(dfr)
#' mx <- matrix(letters[1:12], 4, 3)
#' as_huxtable(mx, add_colnames = FALSE)
#' library(stats)
#' tbl <- table(
#' Wool = warpbreaks$wool,
#' Tension = warpbreaks$tension
#' )
#' as_huxtable(tbl) # adds row and column names by default
#'
#' # adding rownames:
#' as_hux(mtcars[1:3,], add_colnames = TRUE,
#' add_rownames = "Car")
#'
#' if (requireNamespace("dplyr")) {
#' iris_grp <- dplyr::group_by(iris[c(1:4, 51:54, 101:104), ], Species)
#' as_hux(iris_grp, groups_to_headers = TRUE)
#' }
as_huxtable <- function (x, ...) UseMethod("as_huxtable")
#' @export
#' @rdname as_huxtable
as_hux <- as_huxtable
#' @export
#' @rdname as_huxtable
as_huxtable.default <- function (
x,
add_colnames = getOption("huxtable.add_colnames", TRUE),
add_rownames = FALSE,
autoformat = getOption("huxtable.autoformat", TRUE),
...
) {
assert_that(
is.flag(add_colnames),
is.flag(add_rownames) || is.character(add_rownames),
is.flag(autoformat)
)
x <- new_huxtable(x)
col_classes <- sapply(x, function (col) class(col)[1])
if (autoformat) {
dfn <- getOption("huxtable.autoformat_number_format", list())
for (cn in seq_len(ncol(x))) {
# double [[ matters for getting underlying object; also want only most specific class:
cls <- col_classes[cn]
number_format(x)[, cn] <- dfn[[cls]] %||% NA
}
}
# order matters here. We want original rownames, not anything else.
if (is.character(add_rownames)) {
rownames_colname <- add_rownames
add_rownames <- TRUE
} else {
rownames_colname <- "rownames"
}
if (add_rownames) x <- add_rownames(x, preserve_rownames = FALSE, colname = rownames_colname)
if (add_colnames) x <- add_colnames(x)
# this bit comes after add_colnames so that column headers also get aligned:
if (autoformat) {
dfa <- getOption("huxtable.autoformat_align", list())
for (cn in seq_len(ncol(x))) {
cls <- col_classes[cn]
autoal <- dfa[[cls]] %||% NA
align(x)[, cn] <- autoal
if (add_colnames && ! autoal %in% c("left", "right", "center", "centre", NA)) {
align(x)[1, cn] <- "right"
}
}
}
x <- set_attr_dimnames(x)
x
}
#' @export
as_huxtable.huxtable <- function (x, ...) x
#' @export
as_huxtable.matrix <- function(x, add_colnames = FALSE, ...) {
as_huxtable.default(x, add_colnames = add_colnames, ...)
}
#' @export
as_huxtable.table <- function (x, add_colnames = TRUE, add_rownames = TRUE, ...) {
ht <- as_huxtable(unclass(x), add_colnames, add_rownames, ...)
if (add_rownames) {
ht[1, 1] <- ""
}
ht
}
#' @export
as_huxtable.ftable <- function(x, ...) {
ht <- as_huxtable(format(x, quote = FALSE), ...)
number_format(ht) <- 0
ht
}
#' @export
#' @param groups_to_headers Logical. Convert groups to header rows?
#' @rdname as_huxtable
as_huxtable.grouped_df <- function (x, ..., groups_to_headers = FALSE) {
assert_that(is.flag(groups_to_headers))
ht <- NextMethod()
if (groups_to_headers) {
assert_package("as_huxtable.grouped_df", "dplyr")
group_vars <- dplyr::group_vars(x)
for (col in group_vars) {
ht <- column_to_header(ht, col, glue = paste0(col, ": {value}"))
}
}
ht
}
#' @export
as_huxtable.numeric <- function (x, ...) {
# use default otherwise matrix has class e.g. c("matrix", "numeric") so we recurse
as_huxtable.default(as.matrix(x), ...)
}
#' @export
as_huxtable.character <- as_huxtable.numeric
#' @export
as_huxtable.logical <- as_huxtable.numeric
#' @export
as_huxtable.complex <- as_huxtable.numeric
#' @export
#' @rdname as_huxtable
is_huxtable <- function (x) inherits(x, "huxtable")
#' @export
#' @rdname as_huxtable
is_hux <- is_huxtable
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.