#' view
#'
#' Visualize results in RStudio's Viewer or in Web Browser
#'
#' @usage
#' view(x, method = "viewer", file = "", append = FALSE,
#' report.title = NA, table.classes = NA,
#' bootstrap.css = st_options("bootstrap.css"),
#' custom.css = st_options("custom.css"), silent = FALSE,
#' footnote = st_options("footnote"),
#' max.tbl.height = Inf,
#' collapse = 0,
#' escape.pipe = st_options("escape.pipe"), \dots)
#'
#' @inheritParams print.summarytools
#'
#' @aliases view stview
#'
#' @details
#' Creates \emph{html} outputs and displays them in \emph{RStudio}'s viewer, in
#' a browser, or renders the \emph{html} code in \emph{R markdown} documents.
#'
#' For objects of class \dQuote{\emph{summarytools}}, this function is simply
#' a wrapper around \code{\link{print.summarytools}} with
#' \code{method = "viewer"}.
#'
#' Objects of class \dQuote{\emph{by}}, \dQuote{\emph{stby}}, or
#' \dQuote{\emph{list}} are dispatched to the present function, as it can
#' manage multiple objects, whereas \code{\link{print.summarytools}} can only
#' manage one object at a time.
#'
#' @export
view <- function(x,
method = "viewer",
file = "",
append = FALSE,
report.title = NA,
table.classes = NA,
bootstrap.css = st_options("bootstrap.css"),
custom.css = st_options("custom.css"),
silent = FALSE,
footnote = st_options("footnote"),
max.tbl.height = Inf,
collapse = 0,
escape.pipe = st_options("escape.pipe"),
...) {
# Check that the appropriate method is chosen when a file name is given
if (grepl("\\.r?md$", file, ignore.case = TRUE, perl = TRUE) &&
method != "pander") {
message("Switching method to 'pander'")
method <- "pander"
} else if (grepl("\\.html$", file, ignore.case = TRUE, perl = TRUE) &&
method == "pander") {
message("Switching method to 'browser'")
method <- "browser"
}
# Objects not created via by() / stby() / lapply() (not a list) --------------
if (inherits(x, "summarytools") &&
(isTRUE(attr(x, "st_type") %in%
c("freq", "ctable", "descr", "dfSummary")))) {
print.summarytools(x,
method = method,
file = file,
append = append,
report.title = report.title,
table.classes = table.classes,
bootstrap.css = bootstrap.css,
custom.css = custom.css,
silent = silent,
footnote = footnote,
max.tbl.height = max.tbl.height,
collapse = collapse,
escape.pipe = escape.pipe,
...)
} else if (inherits(x = x, what = c("stby","by")) &&
attr(x[[1]], "st_type") == "descr" &&
length(attr(x[[1]], "data_info")$by_var) == 1 &&
((!attr(x[[1]], "data_info")$transposed && dim(x[[1]])[2] == 1) ||
(attr(x[[1]], "data_info")$transposed && dim(x[[1]])[1] == 1))) {
# Special case: descr() + [by() | stby()] objects with 1 variable --------
# A column will become created for every distinct value of the ------------
# grouping variable -------------------------------------------------------
if (attr(x[[1]], "data_info")$transposed) {
xx <- do.call(rbind, x)
} else {
# 1 Column several times - use cbind
xx <- do.call(cbind, x)
class(xx) <- class(x[[1]])
colnames(xx) <- vapply(x, function(k) attr(k, "data_info")$Group,
character(1), USE.NAMES = FALSE)
colnames(xx) <- sub("^.+?= ", "", colnames(xx))
}
attr(xx, "st_type") <- "descr"
attr(xx, "date") <- attr(x[[1]], "date")
attr(xx, "fn_call") <- attr(x[[1]], "fn_call")
attr(xx, "stats") <- attr(x[[1]], "stats")
attr(xx, "data_info") <- attr(x[[1]], "data_info")
attr(xx, "data_info")$by_var_special <-
sub("^.*\\$(.+)", "\\1", attr(x[[1]], "data_info")$by_var)
attr(xx, "data_info")$Group <- NULL
attr(xx, "data_info")$by_first <- NULL
attr(xx, "data_info")$by_last <- NULL
attr(xx, "data_info")$N.Obs <-
sum(sapply(x, function(x) attr(x, "data_info")$N.Obs))
# Remove NA items if any
attr(xx, "data_info") <- attr(xx,"data_info")[!is.na(attr(xx, "data_info"))]
attr(xx, "format_info") <- attr(x[[1]], "format_info")
attr(xx, "user_fmt") <- attr(x[[1]], "user_fmt")
attr(xx, "lang") <- attr(x[[1]], "lang")
print.summarytools(xx,
method = method,
file = file,
append = append,
report.title = report.title,
table.classes = table.classes,
bootstrap.css = bootstrap.css,
custom.css = custom.css,
silent = silent,
footnote = footnote,
collapse = collapse,
escape.pipe = escape.pipe,
...)
} else if (inherits(x = x, what = c("stby", "by", "array")) &&
attr(x[[1]], "st_type") %in%
c("freq", "ctable", "descr", "dfSummary")) {
# html file is being created -- we fix method = "browser"
if (grepl("\\.html$", file, ignore.case = TRUE, perl = TRUE) &&
!grepl(pattern = tempdir(), x = file, fixed = TRUE) &&
method == "pander") {
method <- "browser"
message("Switching method to 'browser'")
}
# Remove NULL objects from list
null_ind <- which(vapply(x, is.null, TRUE))
if (length(null_ind) > 0) {
x <- x[-null_ind]
}
if (method %in% c("viewer", "browser")) {
# by object, viewer / browser --------------------------------------------
file <- ifelse(file == "", paste0(tempfile(),".html"), file)
footnote_safe <- footnote
for (i in seq_along(x)) {
if (grepl(tempdir(), file, fixed = TRUE) && i == length(x)) {
open.doc <- TRUE
} else {
open.doc <- FALSE
}
if (i == length(x)) {
footnote <- footnote_safe
} else {
footnote <- NA
}
if (i == 1) {
if (isTRUE(append) && !is.na(custom.css)) {
stop("Can't append existing html file with new custom.css")
}
if (isTRUE(append) && !is.na(report.title)) {
stop("Can't append existing html file with new report.title")
}
print.summarytools(x[[i]],
method = method,
file = file,
append = append,
report.title = report.title,
table.classes = table.classes,
bootstrap.css = bootstrap.css,
custom.css = custom.css,
silent = silent,
footnote = footnote,
collapse = collapse,
escape.pipe = escape.pipe,
open.doc = open.doc,
...)
} else if (i < length(x)) {
print.summarytools(x[[i]],
method = method,
file = file,
append = TRUE,
table.classes = table.classes,
silent = TRUE,
footnote = footnote,
collapse = collapse,
escape.pipe = escape.pipe,
group.only = TRUE,
open.doc = open.doc,
...)
} else {
print.summarytools(x[[i]],
method = method,
file = file,
append = TRUE,
escape.pipe = escape.pipe,
table.classes = table.classes,
silent = silent,
footnote = footnote,
collapse = collapse,
group.only = TRUE,
open.doc = open.doc,
...)
}
}
} else if (method == "render") {
# by object, render ------------------------------------------------------
for (i in seq_along(x)) {
if (i == 1) {
html_content <-
list(print.summarytools(x[[i]],
method = method,
table.classes = table.classes,
bootstrap.css = bootstrap.css,
custom.css = custom.css,
silent = silent,
footnote = NA,
collapse = collapse,
...))
} else if (i < length(x)) {
html_content[[i]] <-
print.summarytools(x[[i]],
method = method,
table.classes = table.classes,
silent = silent,
footnote = NA,
collapse = collapse,
group.only = TRUE,
...)
} else {
html_content[[i]] <-
print.summarytools(x[[i]],
method = method,
table.classes = table.classes,
silent = silent,
footnote = footnote,
collapse = collapse,
group.only = TRUE,
...)
}
}
return(tagList(html_content))
} else if (method == "pander") {
# by object, pander ------------------------------------------------------
for (i in seq_along(x)) {
if (i == 1) {
print.summarytools(x[[1]],
method = "pander",
silent = silent,
file = file,
append = append,
group.only = FALSE,
escape.pipe = escape.pipe,
...)
} else {
print.summarytools(x[[i]],
method = "pander",
silent = silent,
file = file,
append = ifelse(file == "", FALSE, TRUE),
group.only = TRUE,
escape.pipe = escape.pipe,
...)
}
}
}
} else if (inherits(x = x, what = "list") &&
inherits(x[[1]], "summarytools") &&
attr(x[[1]], "st_type") == "freq") {
if ("ignored" %in% names(attributes(x))) {
message("Variable(s) ignored: ",
paste(attr(x, "ignored"), collapse = ", "))
}
if (method %in% c("viewer", "browser")) {
# list (lapply) object, viewer / browser ---------------------------------
file <- ifelse(file == "", paste0(tempfile(),".html"), file)
if (grepl(tempdir(), file, fixed = TRUE)) {
open.doc <- TRUE
} else {
open.doc <- FALSE
}
for (i in seq_along(x)) {
if (i == 1) {
print.summarytools(x[[1]],
method = method,
file = file,
silent = silent,
footnote = NA,
collapse = collapse,
append = FALSE,
var.only = FALSE,
report.title = report.title,
escape.pipe = escape.pipe,
table.classes = table.classes,
bootstrap.css = bootstrap.css,
custom.css = custom.css,
...)
} else if (i < length(x)) {
print.summarytools(x[[i]],
method = method,
file = file,
append = TRUE,
var.only = TRUE,
silent = TRUE,
footnote = NA,
collapse = collapse,
escape.pipe = escape.pipe,
table.classes = table.classes,
...)
} else {
print.summarytools(x[[i]],
method = method,
file = file,
append = TRUE,
var.only = TRUE,
silent = silent,
footnote = footnote,
collapse = collapse,
escape.pipe = escape.pipe,
table.classes = table.classes,
open.doc = open.doc,
...)
}
}
} else if (method == "render") {
# list (lapply) object, render -------------------------------------------
for (i in seq_along(x)) {
if (i == 1) {
html_content <-
list(print.summarytools(x[[i]],
method = method,
silent = TRUE,
footnote = NA,
collapse = collapse,
table.classes = table.classes,
bootstrap.css = bootstrap.css,
custom.css = custom.css,
var.only = FALSE,
...))
} else if (i < length(x)) {
html_content[[i]] <-
print.summarytools(x[[i]],
method = method,
var.only = TRUE,
silent = TRUE,
footnote = NA,
collapse = collapse,
table.classes = table.classes,
bootstrap.css = FALSE,
var.only = TRUE,
...)
} else {
html_content[[i]] <-
print.summarytools(x[[i]],
method = method,
var.only = TRUE,
silent = silent,
footnote = footnote,
collapse = collapse,
table.classes = table.classes,
bootstrap.css = FALSE,
var.only = TRUE,
...)
}
}
return(tagList(html_content))
} else if (method == "pander") {
# list (lapply) object, pander -------------------------------------------
var.only <- "headings" %in% names(list(...)) &&
!isTRUE(list(...)$headings)
for (i in seq_along(x)) {
if (i == 1) {
#if (isTRUE(var.only)) {
print.summarytools(x[[1]],
method = "pander",
file = file,
silent = silent,
append = append,
escape.pipe = escape.pipe,
var.only = var.only,
...)
} else {
print.summarytools(x[[i]],
method = "pander",
file = file,
silent = silent,
append = ifelse(file == "", FALSE, TRUE),
var.only = TRUE,
escape.pipe = escape.pipe,
...)
}
}
}
} else {
message(
paste(
"x must either be a summarytools object created with freq(), descr(),",
"or a list of summarytools objects created using by()"
)
)
}
}
#' @export
stview <- view
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.