Nothing
#' Render Scripted Attributes of Indicated Components
#'
#' Renders the scripted attributes of indicated components.
#' Generic, with method \code{\link{scripted.default}}.
#' @param x object
#' @param ... passed arguments
#' @export
#' @keywords internal
#' @return see methods
#' @family scripted
#' @seealso modify.default
#' @seealso as_spork
#' @examples
#' example(scripted.default)
scripted <- function(x, ...)UseMethod('scripted')
#' Render Scripted Attributes of Indicated Components by Default
#'
#' Modifies specific attributes of each indicated element
#' (all elements by default).
#'
#' The goal here is to render labels and units (where present)
#' in a way that supports subscripts and superscripts
#' for both plots and tables in either html or latex contexts.
#'
#' The current implementation writes an 'expression' attribute
#' to support figure labels and a 'title' attribute to support
#' tables. \code{\link{print.decorated_ggplot}} will attempt
#' to honor the expression attribute if it exists.
#' \code{\link[tablet]{tablet.data.frame}} will attempt to honor
#' the title attribute if it exists (see Details there).
#' An attempt is made to guess the output format (html or latex).
#'
#' In addition to the 'title' and 'expression' attributes, scripted() writes
#' a 'plotmath' attribute to store plotmath versions of factor levels,
#' where present. \code{\link{print.decorated_ggplot}} should prefer
#' these over their latex and html counterparts. Furthermore,
#' factor levels (and codelists, where present) are converted
#' to their latex or html equivalents. None of this happens
#' if a 'plotmath' attribute already exists, thus preventing
#' the same variable from being accidentally transformed twice.
#'
#' To flexibly support latex, html, and plotmath, this function
#' expects column labels and units to be encoded in "spork" syntax.
#' See \code{\link[spork]{as_spork}} for details and examples.
#' Briefly, "_" precedes a subscript, "^" precedes a superscript,
#' and "." is used to force the termination of either a
#' superscript or a subscript where necessary. For best results,
#' units should be written using *, /, and ^; e.g. "kg*m^2/s^2"
#' not "kg m2 s-2" (although both are valid:
#' see \code{\link{is_parseable}}). A literal backslash followed by "n"
#' represents a newline. Greek letters are represented by their names,
#' except where names are enclosed in backticks.
#'
#'
#' \code{scripted()} always calls \code{resolve()} for the indicated
#' columns, to make units present where appropriate.
#'
#' @param x object
#' @param ... indicated columns, or name-value pairs; passed to \code{\link{resolve}} and \code{\link{selected}}
#' @param open character to precede units
#' @param close character to follow units
#' @param format one of 'latex' or 'html'
#' @export
#' @importFrom knitr is_latex_output
#' @importFrom spork as_html as_latex as_plotmath concatenate htmlToken as_spork
#' @return 'scripted', a superclass of x
#' @family scripted
#' @family interface
#' @examples
#' library(magrittr)
#' library(ggplot2)
#' x <- data.frame(time = 1:10, work = (1:10)^1.5)
#' x %<>% decorate('
#' time: [ Time_elapsed, h ]
#' work: [ Work_total_observed, kg*m^2/s^2 ]
#' ')
#'
#' x %>% decorations
#' x %>% ggplot(aes(time, work)) + geom_point()
#' x %>% scripted %>% ggplot(aes(time, work)) + geom_point()
#' x %>% scripted(format = 'html') %$% work %>% attr('title')
#' testthat::expect_equal(scripted(x), scripted(scripted(x)))
scripted.default <- function(
x,
...,
open = getOption("yamlet_append_units_open", " ("),
close = getOption("yamlet_append_units_close", ")"),
format = getOption("yamlet_format", ifelse(knitr::is_latex_output(), 'latex','html'))
){
stopifnot(
is.character(format),
length(format) == 1,
format %in% c('latex','html')
)
stopifnot(is.character(open) | is.null(open))
stopifnot(is.character(close) | is.null(close))
stopifnot(length(open) %in% 0:1)
stopifnot(length(close) %in% 0:1)
x <- resolve(x, ...) # removes html or latex tail where present
vars <- selected(x, ...)
for(var in vars){
label <- attr(x[[var]], 'label')
units <- attr(x[[var]], 'units')
# render factor levels where present and untouched
# for idempotency, use presence of plotmath attribute
# as evidence of prior rendering
if(
!is.null(levels(x[[var]])) &
is.null(attr(x[[var]], 'plotmath'))
){
attr(x[[var]], 'plotmath') <- as_plotmath(as_spork(levels(x[[var]])))
if(format == 'latex'){
levels(x[[var]]) <- as_latex(as_spork(levels(x[[var]])))
class(x[[var]]) <- union(class(x[[var]]), 'latex')
}
if(format == 'html'){
levels(x[[var]]) <- as_html(as_spork(levels(x[[var]])))
class(x[[var]]) <- union(class(x[[var]]), 'html')
}
# need to maintain internal consistency of 'classified'
# ideally, there should be a method for this
if(inherits(x[[var]], 'classified')){
for(i in seq_along(levels(x[[var]]))){
attr(x[[var]], 'codelist')[[i]] <- levels(x[[var]])[[i]]
}
}
}
# for idempotency, ensure tail is restored for factor-like vars
if(!is.null(levels(x[[var]]))){
if(format == 'latex'){
class(x[[var]]) <- union(class(x[[var]]), 'latex')
} else {
class(x[[var]]) <- union(class(x[[var]]), 'html')
}
}
# explicitly spork-terminate all sub, super in label
if(!is.null(label)){
dots <- gsub('\\\\.','',label)
dots <- gsub('[^.]', '', dots)
dots <- nchar(dots)
subs <- gsub('\\\\_','',label)
subs <- gsub('[^_]', '', subs)
subs <- nchar(subs)
sups <- gsub('\\\\^','',label)
sups <- gsub('[^^]', '', sups)
sups <- nchar(sups)
need <- subs + sups - dots
need <- max(0, need)
tail <- rep('.', need)
tail <- paste(tail, collapse = '')
label <- paste0(label, tail)
}
# https://github.com/r-quantities/units/issues/221
# explicitly spork-terminate all superscripts
# immediately following the integer
if(!is.null(units)){
units <- gsub('(\\^[-]?[0-9]+)','\\1.', units)
}
if(!is.null(units)) units <- c(open, units, close) # nulls disappear!
result <- c(label, units) # nulls disappear!
usable <- result
if(is.null(result)) usable <- ''
usable <- paste(usable, collapse = '') # new
usable <- as_spork(usable)
if(format == 'latex'){
# title = concatenate(spork::as_latex(usable))
title = spork::as_latex(usable)
}
if(format == 'html'){
# title = concatenate(spork::as_html(usable))
title = spork::as_html(usable)
}
# plotm = concatenate(as_plotmath(usable))
plotm = as_plotmath(usable)
# token not null, title not null, plotm not null
if(!is.null(result)) attr(x[[var]], 'title') <- title # ready to use
plotm <- as.expression(plotm)
attr(plotm, 'srcref') <- NULL
attr(plotm, 'srcfile') <- NULL
attr(plotm, 'wholeSrcref') <- NULL
if(!is.null(result)) attr(x[[var]], 'expression') <- plotm #as.expression(plotm)
}
#class(x) <- c('scripted', class(x))
x
}
# Render Scripted Attributes of Scripted Object
#
# Renders the scripted attributes of indicated components.
# As currently implemented, scripted() intends to be idempotent.
# To call scripted() on a scripted object is a non-operation.
# @param x object
# @param ... passed arguments
# @export
# @keywords internal
# @return scripted
# @family scripted
# scripted.scripted <- function(x, ...)x
# @importFrom spork htmlToken
# @export
# spork::htmlToken
# @importFrom spork as_html
# @export
# spork::as_html
# @importFrom spork as_latex
# @export
# spork::as_latex
# @importFrom spork as_plotmath
# @export
# spork::as_plotmath
# @importFrom spork concatenate
# @export
# spork::concatenate
# @importFrom spork as_spork
# @export
# spork::as_spork
# @importFrom dplyr group_vars
# @export
# dplyr::group_vars
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.