R/theme.R
In Crunch-io/crunchtabs: Custom Report Generation for Crunch Datasets
Defines functions
theme_validator
themeDefaultLatex
themeDefaultExcel
themeNew
Documented in
themeDefaultExcel
themeDefaultLatex
themeNew
theme_validator
#' Generate Theme for `writeExcel` or `writeLatex`
#'
#' `themeNew` produces themes for `writeExcel` or `writeLatex`.
#'
#' @section Theme Arguments:
#' \describe{
#' \item{digits}{A numeric. How many digits should the data be rounded to? (In Excel, this is excel styling.) Defaults to 0.}
#' \item{digits_numeric}{A numeric. How many digits should continuous variable data be rounded to? (In Latex, , this is Latex styling.) Defaults to 2.}
#' \item{digits_final}{In Excel, an optional numeric. How many digits should the data be rounded to before being added to Excel?}
#' \item{excel_footer}{In Excel, an optional character vector of length 3. The footer text of the file.}
#' \item{excel_freeze_column}{In Excel, a numeric. What column should be the last frozen column? Defaults to 1.}
#' \item{excel_header}{In Excel, An optional character vector of length 3. The header text of the file.}
#' \item{excel_orientation}{In Excel, a character. The orientation of the page if printed. Valid options are: "landscape", and "portrait". Defaults to "landscape".}
#' \item{excel_percent_sign}{In Excel, a logical. Should "\%" be pasted in each cell that contains a proportion? Defaults to FALSE.}
#' \item{excel_show_grid_lines}{In Excel, a logical. Should the default grid lines of the file show? Defaults to FALSE.}
#' \item{excel_table_border}{In Excel, an optional list. The formatting of the border around each downbreak. Includes: border_color, and border_style.}
#' \item{font}{An optional character. The font to be used.}
#' \item{font_color}{In Excel, an optional color. The color of the font.}
#' \item{font_size}{An optional numeric. The size of the font.}
#' \item{format_banner_categories}{In Excel, a list. How the banner/crossbreak response options should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_banner_names}{In Excel, an optional list. How the banner/crossbreak variable names should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_banner_split}{In Excel, an optional list. How should the banner variables be separated? Includes: border_color, border_style}
#' \itemize{
#' \item{\code{empty_col} In Excel, a logical. Should there be an empty column to separate banner variables? Defaults to FALSE.}
#' }
#' \item{format_headers}{An optional list. How headers should be formatted. If `NULL` headers will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_label_column}{In Excel, a list. How the labels column should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, wrap_text. In LaTeX, allows you to set col_width only, in inches of the crosstab stub globally.}
#' Includes:
#' \itemize{
#' \item{\code{col_width} A numeric. Width of the label column. Defaults to 40.}
#' \item{\code{extend_borders} In Excel, a logical. Should the borders created for certain rows extend to the label column? Defaults to FALSE.}
#' }
#' \item{format_label_column_exceptions}{In LaTeX, a character vector of columns widths, specified in inches and named after the question alias whose stub they would effect.}
#' \item{format_means}{An optional list. How means should be formatted. If `NULL` means will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.}
#' \item{format_medians}{An optional list. How medians should be formatted. If `NULL` medians will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.}
#' \item{format_min_base}{An optional list. If a minimum base size is desired, how variables that fall below that base size should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, wrap_text}
#' Includes:
#' \itemize{
#' \item{\code{mask} An optional character to be used to mark cells with base below the min_base.}
#' \item{\code{min_base} An optional numeric. The minimum acceptable base size for a question.}
#' }
#' \item{format_subtitle}{An optional list. How the table subtitle should be formatted. If `NULL` the table subtitle will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_subtotals}{An optional list. How subtotals should be formatted. If `NULL` subtotals will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_title}{An optional list. How the table title should be formatted. If `NULL` the table title will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_totals_column}{In Excel, a list. How the totals column should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_totals_row}{An optional list. How total rows should be formatted. If `NULL` total rows will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.}
#' \item{format_var_alias}{An optional list. How downbreak variable aliases should be formatted. If `NULL` downbreak variable aliases will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_q_number, valign, and wrap_text.}
#' \item{format_var_description}{An optional list. How downbreak variable descriptions should be formatted. If `NULL` downbreak variable descriptions will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.}
#' \item{format_var_filtertext}{An optional list. How downbreak variable filtertext/notes should be formatted. If `NULL` downbreak variable filtertext/notes will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.}
#' \item{format_var_name}{An optional list. How downbreak variable names should be formatted. If `NULL` downbreak variable names will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.}
#' \item{format_var_subname}{An optional list. How downbreak subvariable names should be formatted. If `NULL` downbreak subvariable names will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, valign, and wrap_text.}
#' \item{format_unweighted_n}{An optional list. How unweighted Ns should be formatted. If `NULL` unweighted Ns will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_fixed, position_top, valign, and wrap_text.}
#' \item{format_weighted_n}{An optional list. How weighted Ns should be formatted. If `NULL` weighted Ns will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_fixed, position_top, valign, and wrap_text.}
#' \item{latex_foottext}{In Latex, a character. A character string indicating what text should be placed at the top of continuation tables. 'tbc' is a shortcut for 'to be continued.'}
#' \item{latex_headtext}{In Latex, a character. A character string indicating what text should be placed at the bottom of continuation tables. 'tbc' is a shortcut for 'to be continued.'}
#' \item{latex_max_lines_for_tabular}{In Latex, an integer. What is the maximum number of lines a table can be before it is converted to a longtable? Currently only works on toplines. Defaults to 0.}
#' \item{latex_multirowheaderlines}{In Latex, a logical. Should banners allow multi-row headlines? Defaults to FALSE.}
#' \item{latex_round_percentages}{In Latex, a logical. In Latex, should percentages be recalculated so they do not exceed 100\% where necessary? Defaults to FALSE.}
#' \item{latex_round_percentages_exception}{In Latex, an optional character. A list of variable aliases that should have the opposite behaviour of that specified in latex_round_percentages.}
#' \item{latex_table_align}{In Latex, a character. A character string indicating what the table alignment should be. Defaults to 'r'.}
#' \item{latex_flip_grids}{In Latex, a logical. Categorical arrays will be flipped so that there rows are now transposed to columns.}
#' \item{latex_flip_specific_grids}{An optional vector of aliases whose presentation should be transposed}
#' \item{logo}{An optional list. Information about the logo to be included in the tables.}
#' Includes:
#' \itemize{
#' \item{\code{file} The path to a PNG file that should be used for the logo. Include the extension (.png) for an Excel theme. Exclude the extension for a Latex theme }
#' \item{\code{dpi} In Excel, a numeric. The image resolution used for conversion between units. Defaults to 300.}
#' \item{\code{height} In Excel, a numeric. The height of the logo. Defaults to 2.}
#' \item{\code{width} In Excel, a numeric. The width of the logo. Defaults to 4.}
#' \item{\code{startCol} In Excel, a numeric. The column coordinate of upper left corner of the logo. Defaults to 1.}
#' \item{\code{startRow} In Excel, a numeric. The row coordinate of upper left corner of the logo. Defaults to 1.}
#' \item{\code{units} In Excel, a character. Units of width and height. Valid options are: "cm", "in", and "px." Defaults to "in".}
#' }
#' \item{one_per_sheet}{A logical. Should each question be on its own sheet/page? Defaults to FALSE.}
#' }
#'
#' \subsection{Subarguments}{
#' \describe{
#' \item{background_color}{In Excel, an optional color. Cell background color.}
#' \item{border_bottom}{In Excel, an optional logical. Should there be a border on the bottom? }
#' \item{border_color}{In Excel, an optional color. The border color of the relevant cells.}
#' \item{border_left}{In Excel, an optional logical. Should there be a border on the left of the relevant cells? }
#' \item{border_right}{In Excel, an optional logical. Should there be a border on the right of the relevant cells? }
#' \item{border_style}{In Excel, an optional character. The style of the border of the relevant cells. Valid options are: "dashDot", "dashDotDot", "dashed", "dotted", "double", "hair", "medium", "mediumDashDot", "mediumDashDotDot", "mediumDashed", "none", "slantDashDot", "thick", and "thin".}
#' \item{border_top}{In Excel, an optional logical. Should there be a border on the top of the relevant cells? }
#' \item{decoration}{An optional character vector. Text decorations to be applied to relevant cells. Valid options are: "bold", "italic", "strikeout", "underline", and "underline2".}
#' \item{font}{An optional character. The font to be used.}
#' \item{font_color}{In Excel, an optional color. The color of the font.}
#' \item{font_size}{An optional numeric. The size of the font.}
#' \item{halign}{In Excel, an optional character. The horizontal alignment of the text. Valid options are: "center", "left", and "right".}
#' \item{include_alias}{A logical. Should the alias of the variable be included with the other information? Defaults to FALSE.}
#' \item{include_q_number}{A logical. Should the question number be included with the other information? Defaults to FALSE.}
#' \item{latex_add_parenthesis}{In Latex, a logical. Should parenthesis be added surrounding the values? Defaults to FALSE.}
#' \item{latex_adjust}{In Latex, an optional character. How should the values be adjusted? Can be missing.}
#' \item{name}{A character. The name to be used for the relevant row(s).}
#' \item{position_bottom}{In Excel, a logical. Should the relevant row(s) be at the bottom of each table? Defaults to TRUE.}
#' \item{position_fixed}{In Excel, a logical. Should the relevant row(s) be fixed at the top of the file with the banner? Defaults to FALSE.}
#' \item{position_top}{In Excel, a logical. Should should the relevant row(s) be at the top of each table? Defaults to FALSE.}
#' \item{repeat_for_subs}{A logical. Should the information be repeated for each subvariable? Defaults to TRUE.}
#' \item{pagebreak_in_banner}{A logical. Allow a banner to be broken midway across pages. Defaults to TRUE. If FALSE, Pushes the page breaking banner sub-table to the next page similar to manually using clearpage}
#' \item{valign}{In Excel, an optional character. The vertical alignment of the text. Valid options are: "bottom", "center", and "top".}
#' \item{wrap_text}{In Excel, an optional logical. Should the text wrap if it extends beyond the width of the cell? Defaults to TRUE.}
#' }
#' }
#'
#' @param ... Named arguments that specify the various output types. See the Theme Arguments section below for a complete listing.
#' @param default_theme a theme object to use for defaults if you're modifying an already existing themes
#'
#' @export
#' @importFrom utils modifyList
themeNew <- function(..., default_theme = themeDefaultExcel()) {
wrong_class_error(default_theme, "Theme", "default_theme")
# will not pass cyclomatic complexity
dots <- list(...)
if (any(names(dots) == "")) {
stop("All arguments must have a name.")
}
for (nm in setdiff(names(dots), names(default_theme))) {
if (length(unlist(validators_to_use[[nm]]["include"])) > 1) {
default_theme[[nm]] <- list()
for (incl in setdiff(validators_to_use[[nm]]$include, dots[[nm]])) {
if (as.logical(validators_to_use[[incl]]["missing"])) {
next
} else if (incl %in% names(default_theme)) {
default_theme[[nm]][[incl]] <- default_theme[[incl]]
} else if (!is.null(validators_to_use[[incl]]["default"]) &&
!is.na(validators_to_use[[incl]]["default"])) {
rsp <- unlist(validators_to_use[[incl]]["default"])
if (validators_to_use[[incl]]["class"] %in% "logical") {
default_theme[[nm]][[incl]] <- as.logical(rsp)
}
else if (validators_to_use[[incl]]["class"] %in% "numeric") {
default_theme[[nm]][[incl]] <- as.numeric(rsp)
}
else {
default_theme[[nm]][[incl]] <- rsp
}
} else if (incl %in% "name") {
default_theme[[nm]][[incl]] <- gsub(
"(^|[[:space:]])([[:alpha:]])", "\\1\\U\\2",
gsub("_", " ", gsub("format_", "", nm)),
perl = TRUE
)
} else {
print(paste(nm, incl))
}
}
}
}
theme <- modifyList(default_theme, dots, keep.null = TRUE)
theme <- theme[union(names(dots), names(default_theme))]
if (theme$latex_headtext %in% "tbc") theme$latex_headtext <- "continued from previous page"
if (theme$latex_foottext %in% "tbc") theme$latex_foottext <- "continued on the next page \\dots"
theme_validator(theme)
class(theme) <- "Theme"
return(theme)
}
#' Generate default Theme for `writeExcel`
#'
#' \code{themeDefaultExcel} is the default theme. Users can change base options
#'
#' @param font the font to use (default: Calibri)
#' @param font_size the font size to use (default: 12)
#' @param font_color the color of the type (default: black)
#' @param valign the alignment to use in cells (default: center)
#'
#' @return A set of theme defaults for use in `writeExcel`
#'
#' @export
themeDefaultExcel <- function(
font = getOption("font", default = "Calibri"),
font_size = getOption("font_size", default = 12),
font_color = getOption("font_color", default = "black"),
valign = getOption("valign", default = "center")) {
fn <- font
fs <- font_size
fc <- font_color
va <- valign
norm_maker <- function(font = fn, font_size = fs,
font_color = fc, decoration = NULL, valign = va, wrap_text = TRUE,
border_style = "thin", border_color = "black", border_top = FALSE,
border_bottom = FALSE, border_left = FALSE, border_right = FALSE) {
list(
font = font, font_size = font_size, font_color = font_color,
decoration = decoration, valign = valign, wrap_text = wrap_text,
border_style = border_style, border_color = border_color,
border_top = border_top, border_bottom = border_bottom,
border_left = border_left, border_right = border_right
)
}
position_list <- list(position_top = FALSE, position_bottom = TRUE)
var_incl <- function(include_alias = FALSE, include_q_number = FALSE,
repeat_for_subs = TRUE) {
list(
include_alias = include_alias, include_q_number = include_q_number,
repeat_for_subs = repeat_for_subs
)
}
defaults <- list(
font = font, font_size = fs, font_color = font_color, valign = valign, halign = "center",
format_title = norm_maker(font_size = fs + 4, decoration = "bold"),
format_subtitle = norm_maker(font_size = fs + 2, decoration = "bold"),
format_banner_names = c(norm_maker(border_bottom = TRUE, decoration = "bold"),
halign = "center"
),
format_banner_categories = c(norm_maker(decoration = "bold"), halign = "center"),
format_var_name = c(norm_maker(decoration = "bold"), var_incl(include_q_number = TRUE),
halign = "left"
),
format_var_subname = c(norm_maker(decoration = "bold"),
unlist(var_incl(repeat_for_subs = NULL)),
halign = "left"
),
format_var_description = c(norm_maker(font_color = "#444444"), var_incl(), halign = "left"),
format_var_filtertext = c(norm_maker(decoration = "italic"), var_incl(), halign = "left"),
format_label_column = c(norm_maker(), col_width = 40, halign = "right", extend_borders = TRUE),
format_subtotals = norm_maker(decoration = "bold"),
format_headers = norm_maker(decoration = "bold"),
format_means = c(name = "Mean", norm_maker(decoration = "bold"), position_list),
format_medians = c(name = "Median", norm_maker(decoration = "bold"), position_list),
format_unweighted_n = c(
name = "Unweighted N", norm_maker(decoration = "bold"), position_list,
position_fixed = FALSE, halign = "center",
latex_add_parenthesis = TRUE
),
format_totals_row = c(
name = "Totals", norm_maker(border_top = TRUE, decoration = "bold"),
position_list, halign = "center"
),
format_totals_column = norm_maker(),
excel_show_grid_lines = FALSE,
excel_orientation = "portrait",
excel_freeze_column = 1,
excel_percent_sign = TRUE,
digits = 0,
digits_numeric = 2,
one_per_sheet = FALSE,
latex_round_percentages = TRUE,
enforce_onehundred = FALSE,
latex_headtext = "",
latex_foottext = "",
latex_page_numbers = TRUE,
latex_table_align = "r",
latex_multirowheaderlines = TRUE,
latex_flip_grids = FALSE,
latex_max_lines_for_tabular = 0
)
class(defaults) <- "Theme"
return(defaults)
}
#' Generate default Theme for `writeLatex`
#'
#' \code{themeDefaultLatex} is the default theme. Users can change base options
#'
#' @param font the font to use (default: `"helvet"` for Helvetica)
#' @param font_size the font size to use (default: 12)
#'
#' @return A set of theme defaults for use in `writeLatex`
#'
#' @export
themeDefaultLatex <- function(font = getOption("font", default = "helvet"),
font_size = getOption("font_size", default = 12)) {
norm <- list(font = font, font_size = NULL)
defaults <- list(
font = font, font_size = font_size,
format_title = list(font_size = font_size + 4, decoration = "bold"),
format_subtitle = list(font_size = font_size, decoration = "bold"),
format_banner_categories = norm,
format_var_description = c(norm,
include_alias = FALSE,
include_q_number = TRUE, repeat_for_subs = TRUE
),
format_var_subname = c(norm, include_alias = FALSE, include_q_number = FALSE),
format_var_filtertext = list(
font_size = font_size - 4, decoration = "italic",
include_alias = FALSE, include_q_number = FALSE, repeat_for_subs = TRUE
),
format_subtotals = c(norm, decoration = "bold"),
format_headers = c(norm, decoration = "bold"),
format_unweighted_n = c(norm,
name = "Unweighted N",
position_top = FALSE, position_bottom = TRUE, position_fixed = FALSE,
latex_add_parenthesis = FALSE, latex_adjust = "c"
),
format_totals_row = c(norm,
name = "Totals",
position_top = FALSE, position_bottom = TRUE
),
format_label_column = c(norm, col_width = NA_real_, extend_borders = FALSE),
format_totals_column = norm,
digits = 0,
digits_numeric = 2,
one_per_sheet = TRUE,
excel_percent_sign = TRUE,
excel_show_grid_lines = FALSE,
excel_freeze_column = 0,
excel_orientation = "portrait",
latex_round_percentages = FALSE,
enforce_onehundred = FALSE,
latex_headtext = "",
latex_foottext = "",
latex_table_align = "r",
latex_multirowheaderlines = TRUE,
latex_max_lines_for_tabular = 0,
latex_page_numbers = TRUE,
latex_flip_grids = FALSE,
pagebreak_in_banner = TRUE
)
class(defaults) <- "Theme"
return(defaults)
}
# nolint start
theme_validators <- list(
"find_validator" = function(value, name) {
validator <- validators_to_use[[tail(name, 1)]]
if (!as.logical(validator["missing"]) && is.null(value)) {
return(theme_validators$null_error(name))
} else if (is.null(value)) {
return(NULL)
} else if (is.list(validator)) {
if ("include" %in% names(validator)) {
if (!is.list(value)) {
return(
theme_validators$class_error(
value, "list", name,
as.logical(validator["missing"])
)
)
}
return(sapply(validator$include, function(nm) {
return(theme_validators$find_validator(value[[nm]], c(name, nm)))
}))
}
return(theme_validators$valid_values(value, name, validator))
}
if (!is.na(validator["len"]) && length(value) != as.numeric(validator["len"])) {
return(theme_validators$length_error(
value, validator["len"], name,
validator["missing"]
))
}
if (is.integer(value)) {
value <- as.numeric(value)
}
if (validator["class"] %in% "color") {
return(theme_validators$color(value, name))
} else if (class(value) != validator["class"]) {
return(theme_validators$class_error(
value, validator["class"], name,
validator["missing"]
))
}
},
"class_error" = function(value, expected_class, name, missing) {
return(paste0(
"`", paste0(name, collapse = ":"), "`",
if (as.logical(missing)) ", if provided,", " must be of class ",
expected_class, ", not ", collapse_items(class(value)), "."
))
},
"null_error" = function(name) {
return(paste0(
"`", paste0(name, collapse = ":"),
"` must have a value. It cannot be `NULL`."
))
},
"length_error" = function(value, len, name, missing) {
return(paste0(
"`", paste0(name, collapse = ":"), "`",
if (as.logical(missing)) ", if provided,", " must have length ",
len, ", not ", length(value), "."
))
},
"valid_values" = function(value, name, validator) {
if (!validator$mult && length(value) != 1) {
return(theme_validators$length_error(value, 1, name, validator["missing"]))
} else if (class(value) != "character") {
return(theme_validators$class_error(value, "character", name, validator["missing"]))
} else if (!all(tolower(value) %in% tolower(validator$valid))) {
vals <- paste0("'", validator$valid, "'", collapse = ", ")
if (nchar(vals) > 100) vals <- paste0(substr(vals, 1, 100), "...")
return(paste0(
"`", paste0(name, collapse = ":"), "`",
if (as.logical(validator["missing"])) ", if provided,", " must be in ",
vals, ", not ", paste0("'", value, "'", collapse = ", "), "."
))
}
},
"color" = function(value, name) {
if (class(value) != "character") {
return(theme_validators$class_error(value, "character", name, TRUE))
} else if (!(value %in% colors() | grepl("^#(\\d|[a-f]){6,8}$", value, ignore.case = TRUE))) {
return(paste0("`", paste0(name, collapse = ":"), "` must be a color."))
}
}
)
# nolint end
norm <- list(
"font", "font_size", "font_color", "background_color", "valign",
"halign", "wrap_text", "decoration", "font_size", "border_style",
"border_color", "border_top", "border_bottom", "border_left", "border_right"
)
validators_to_use <- list(
background_color = c(class = "color", len = 1, missing = TRUE),
format_banner_split = list(
missing = TRUE,
include = list("border_style", "border_color", "empty_col")
),
border_color = c(class = "color", len = 1, missing = TRUE),
border_style = list(
mult = FALSE, missing = TRUE,
valid = list(
"none", "thin", "medium", "dashed", "dotted", "thick",
"double", "hair", "mediumDashed", "dashDot", "mediumDashDot", "dashDotDot",
"mediumDashDotDot", "slantDashDot"
)
),
border_top = c(class = "logical", len = 1, missing = TRUE),
border_bottom = c(class = "logical", len = 1, missing = TRUE),
border_left = c(class = "logical", len = 1, missing = TRUE),
border_right = c(class = "logical", len = 1, missing = TRUE),
col_width = c(class = "numeric", len = 1, missing = FALSE, default = 40),
decoration = list(
mult = TRUE, missing = TRUE,
valid = list("bold", "strikeout", "italic", "underline", "underline2")
),
digits = c(class = "numeric", len = 1, missing = FALSE, default = 0),
digits_numeric = c(class = "numeric", len = 1, missing = FALSE, default = 2),
digits_final = c(class = "numeric", len = 1, missing = TRUE),
dpi = c(class = "numeric", len = 1, missing = FALSE, default = 300),
empty_col = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
extend_borders = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
file = c(class = "character", len = 1, missing = TRUE),
font = c(class = "character", len = 1, missing = TRUE),
font_color = c(class = "color", len = 1, missing = TRUE),
font_size = c(class = "numeric", len = 1, missing = TRUE),
excel_footer = c(class = "character", len = 3, missing = TRUE),
format_banner_categories = list(missing = FALSE, include = norm),
format_banner_names = list(missing = TRUE, include = norm),
format_title = list(missing = TRUE, include = norm),
format_headers = list(missing = TRUE, include = norm),
format_label_column = list(
missing = TRUE,
include = c(norm, "col_width", "extend_borders")
),
format_label_column_exceptions = c(class = "numeric", len = NA, missing = TRUE),
format_means = list(
missing = TRUE,
include = c(norm, "name", "position_top", "position_bottom")
),
format_medians = list(
missing = TRUE,
include = c(norm, "name", "position_top", "position_bottom")
),
format_min_base = list(missing = TRUE, include = c(norm, "min_base", "mask")),
format_subtitle = list(missing = TRUE, include = norm),
format_subtotals = list(missing = TRUE, include = norm),
format_totals_column = list(missing = FALSE, include = norm),
format_totals_row = list(
missing = TRUE,
include = c("name", norm, "position_top", "position_bottom")
),
format_unweighted_n = list(
missing = TRUE,
include = c("name", norm, "position_top", "position_bottom", "position_fixed")
),
format_var_alias = list(missing = TRUE, include = c(norm, "include_q_number")),
format_var_name = list(
missing = TRUE,
include = c(norm, "include_alias", "repeat_for_subs", "include_q_number")
),
format_var_description = list(
missing = TRUE,
include = c(norm, "include_alias", "repeat_for_subs", "include_q_number")
),
format_var_subname = list(
missing = TRUE,
include = c(norm, "include_alias", "include_q_number")
),
format_var_filtertext = list(
missing = TRUE,
include = c(norm, "include_alias", "repeat_for_subs", "include_q_number")
),
format_weighted_n = list(
missing = TRUE,
include = c("name", norm, "position_top", "position_bottom", "position_fixed")
),
excel_freeze_column = c(class = "numeric", len = 1, missing = FALSE, default = 1),
halign = list(mult = FALSE, missing = TRUE, valid = list("left", "right", "center")),
excel_header = c(class = "character", len = 3, missing = TRUE),
height = c(class = "numeric", len = 1, missing = FALSE, default = 2),
include_alias = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
include_q_number = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_add_parenthesis = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_adjust = c(class = "character", len = 1, missing = TRUE),
latex_foottext = c(class = "character", len = 1, missing = FALSE, default = ""),
latex_headtext = c(class = "character", len = 1, missing = FALSE, default = ""),
latex_max_lines_for_tabular = c(class = "numeric", len = 1, missing = FALSE, default = 0),
latex_multirowheaderlines = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_round_percentages = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_round_percentages_exception = c(class = "character", len = NA, missing = TRUE),
enforce_onehundred = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_table_align = c(class = "character", len = 1, missing = FALSE, default = ""),
latex_flip_grids = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_flip_specific_grids = c(class = "character", len = NA, missing = TRUE),
latex_page_numbers = c(class = "logical", len = 1, missing = FALSE, default = TRUE),
logo = list(missing = TRUE, include = list(
"file", "startRow", "startCol",
"width", "height", "units", "dpi"
)),
mask = c(class = "character", len = 1, missing = TRUE),
min_base = c(class = "numeric", len = 1, missing = TRUE),
name = c(class = "character", len = 1, missing = FALSE),
one_per_sheet = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
excel_orientation = list(
mult = FALSE, missing = FALSE,
valid = list("portrait", "landscape"), default = "landscape"
),
excel_percent_sign = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
position_bottom = c(class = "logical", len = 1, missing = FALSE, default = TRUE),
position_fixed = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
position_top = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
repeat_for_subs = c(class = "logical", len = 1, missing = FALSE, default = TRUE),
pagebreak_in_banner = c(class = "logical", len = 1, missing = TRUE, default = TRUE),
excel_show_grid_lines = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
startCol = c(class = "numeric", len = 1, missing = FALSE, default = 1),
startRow = c(class = "numeric", len = 1, missing = FALSE, default = 1),
excel_table_border = list(missing = TRUE, include = list("border_style", "border_color")),
units = list(mult = FALSE, missing = FALSE, valid = list("in", "cm", "px"), default = "in"),
valign = list(mult = FALSE, missing = TRUE, valid = list("top", "bottom", "center")),
width = c(class = "numeric", len = 1, missing = FALSE, default = 4),
wrap_text = c(class = "logical", len = 1, missing = TRUE, default = TRUE)
)
#' Theme Validator
#'
#' Validates a theme.
#'
#' @param theme An object from \link{themeNew}
theme_validator <- function(theme) {
theme_required <- c(
"digits", "digits_numeric", "digits_final", "excel_footer",
"excel_freeze_column", "excel_header", "excel_orientation",
"excel_percent_sign", "excel_show_grid_lines", "excel_table_border",
"font", "font_color", "font_size", "format_banner_categories",
"format_banner_names", "format_banner_split", "format_headers",
"format_label_column", "format_label_column_exceptions", "format_means",
"format_medians", "format_min_base",
"format_subtitle", "format_subtotals", "format_title",
"format_totals_column", "format_totals_row", "format_unweighted_n",
"format_var_alias", "format_var_description", "format_var_filtertext",
"format_var_name", "format_var_subname", "format_weighted_n", "halign",
"latex_foottext", "latex_headtext", "latex_max_lines_for_tabular",
"latex_multirowheaderlines", "latex_round_percentages", "enforce_onehundred",
"latex_flip_grids", "latex_round_percentages_exception", "latex_page_numbers",
"latex_table_align", "logo", "one_per_sheet", "valign", "pagebreak_in_banner",
"latex_flip_specific_grids"
)
ignore <- setdiff(names(theme), theme_required)
if (length(ignore) > 0) {
warning(
"Arguments: ", collapse_items(ignore),
" are not supported in themeNew and will be ignored."
)
}
errors <- unlist(sapply(theme_required, function(name) {
theme_validators$find_validator(theme[[name]], name)
}))
if (is.numeric(theme$digits) && theme$digits > 20) {
errors <- c(errors, "`digits` must be less than 20.")
}
if (length(errors) != 0) {
if (length(errors) > 5) {
stop("\n", paste0(errors[1:5], collapse = "\n"),
"\nAnd ", length(errors) - 5, " more errors.",
call. = FALSE
)
}
stop("\n", paste0(errors, collapse = "\n"), call. = FALSE)
}
# Issue 88
if ("logo" %in% names(theme)) {
# Check if version of logo exists:
wo_png <- file.exists(paste0(theme$logo$file, ".png"))
w_png <- file.exists(paste0(theme$logo$file))
if (!(wo_png | w_png)) {
stop("Logo file not found, check path to file or current working directory.")
}
}
}
Crunch-io/crunchtabs documentation built on Aug. 19, 2024, 9:23 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions theme_validator themeDefaultLatex themeDefaultExcel themeNew
Documented in themeDefaultExcel themeDefaultLatex themeNew theme_validator
#' Generate Theme for `writeExcel` or `writeLatex`
#'
#' `themeNew` produces themes for `writeExcel` or `writeLatex`.
#'
#' @section Theme Arguments:
#' \describe{
#' \item{digits}{A numeric. How many digits should the data be rounded to? (In Excel, this is excel styling.) Defaults to 0.}
#' \item{digits_numeric}{A numeric. How many digits should continuous variable data be rounded to? (In Latex, , this is Latex styling.) Defaults to 2.}
#' \item{digits_final}{In Excel, an optional numeric. How many digits should the data be rounded to before being added to Excel?}
#' \item{excel_footer}{In Excel, an optional character vector of length 3. The footer text of the file.}
#' \item{excel_freeze_column}{In Excel, a numeric. What column should be the last frozen column? Defaults to 1.}
#' \item{excel_header}{In Excel, An optional character vector of length 3. The header text of the file.}
#' \item{excel_orientation}{In Excel, a character. The orientation of the page if printed. Valid options are: "landscape", and "portrait". Defaults to "landscape".}
#' \item{excel_percent_sign}{In Excel, a logical. Should "\%" be pasted in each cell that contains a proportion? Defaults to FALSE.}
#' \item{excel_show_grid_lines}{In Excel, a logical. Should the default grid lines of the file show? Defaults to FALSE.}
#' \item{excel_table_border}{In Excel, an optional list. The formatting of the border around each downbreak. Includes: border_color, and border_style.}
#' \item{font}{An optional character. The font to be used.}
#' \item{font_color}{In Excel, an optional color. The color of the font.}
#' \item{font_size}{An optional numeric. The size of the font.}
#' \item{format_banner_categories}{In Excel, a list. How the banner/crossbreak response options should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_banner_names}{In Excel, an optional list. How the banner/crossbreak variable names should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_banner_split}{In Excel, an optional list. How should the banner variables be separated? Includes: border_color, border_style}
#' \itemize{
#' \item{\code{empty_col} In Excel, a logical. Should there be an empty column to separate banner variables? Defaults to FALSE.}
#' }
#' \item{format_headers}{An optional list. How headers should be formatted. If `NULL` headers will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_label_column}{In Excel, a list. How the labels column should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, wrap_text. In LaTeX, allows you to set col_width only, in inches of the crosstab stub globally.}
#' Includes:
#' \itemize{
#' \item{\code{col_width} A numeric. Width of the label column. Defaults to 40.}
#' \item{\code{extend_borders} In Excel, a logical. Should the borders created for certain rows extend to the label column? Defaults to FALSE.}
#' }
#' \item{format_label_column_exceptions}{In LaTeX, a character vector of columns widths, specified in inches and named after the question alias whose stub they would effect.}
#' \item{format_means}{An optional list. How means should be formatted. If `NULL` means will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.}
#' \item{format_medians}{An optional list. How medians should be formatted. If `NULL` medians will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.}
#' \item{format_min_base}{An optional list. If a minimum base size is desired, how variables that fall below that base size should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, wrap_text}
#' Includes:
#' \itemize{
#' \item{\code{mask} An optional character to be used to mark cells with base below the min_base.}
#' \item{\code{min_base} An optional numeric. The minimum acceptable base size for a question.}
#' }
#' \item{format_subtitle}{An optional list. How the table subtitle should be formatted. If `NULL` the table subtitle will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_subtotals}{An optional list. How subtotals should be formatted. If `NULL` subtotals will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_title}{An optional list. How the table title should be formatted. If `NULL` the table title will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_totals_column}{In Excel, a list. How the totals column should be formatted. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, valign, and wrap_text.}
#' \item{format_totals_row}{An optional list. How total rows should be formatted. If `NULL` total rows will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_top, valign, and wrap_text.}
#' \item{format_var_alias}{An optional list. How downbreak variable aliases should be formatted. If `NULL` downbreak variable aliases will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_q_number, valign, and wrap_text.}
#' \item{format_var_description}{An optional list. How downbreak variable descriptions should be formatted. If `NULL` downbreak variable descriptions will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.}
#' \item{format_var_filtertext}{An optional list. How downbreak variable filtertext/notes should be formatted. If `NULL` downbreak variable filtertext/notes will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.}
#' \item{format_var_name}{An optional list. How downbreak variable names should be formatted. If `NULL` downbreak variable names will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, repeat_for_subs, valign, and wrap_text.}
#' \item{format_var_subname}{An optional list. How downbreak subvariable names should be formatted. If `NULL` downbreak subvariable names will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, include_alias, include_q_number, valign, and wrap_text.}
#' \item{format_unweighted_n}{An optional list. How unweighted Ns should be formatted. If `NULL` unweighted Ns will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_fixed, position_top, valign, and wrap_text.}
#' \item{format_weighted_n}{An optional list. How weighted Ns should be formatted. If `NULL` weighted Ns will not appear. Includes: background_color, border_bottom, border_color, border_left, border_right, border_style, border_top, decoration, font, font_color, font_size, halign, name, position_bottom, position_fixed, position_top, valign, and wrap_text.}
#' \item{latex_foottext}{In Latex, a character. A character string indicating what text should be placed at the top of continuation tables. 'tbc' is a shortcut for 'to be continued.'}
#' \item{latex_headtext}{In Latex, a character. A character string indicating what text should be placed at the bottom of continuation tables. 'tbc' is a shortcut for 'to be continued.'}
#' \item{latex_max_lines_for_tabular}{In Latex, an integer. What is the maximum number of lines a table can be before it is converted to a longtable? Currently only works on toplines. Defaults to 0.}
#' \item{latex_multirowheaderlines}{In Latex, a logical. Should banners allow multi-row headlines? Defaults to FALSE.}
#' \item{latex_round_percentages}{In Latex, a logical. In Latex, should percentages be recalculated so they do not exceed 100\% where necessary? Defaults to FALSE.}
#' \item{latex_round_percentages_exception}{In Latex, an optional character. A list of variable aliases that should have the opposite behaviour of that specified in latex_round_percentages.}
#' \item{latex_table_align}{In Latex, a character. A character string indicating what the table alignment should be. Defaults to 'r'.}
#' \item{latex_flip_grids}{In Latex, a logical. Categorical arrays will be flipped so that there rows are now transposed to columns.}
#' \item{latex_flip_specific_grids}{An optional vector of aliases whose presentation should be transposed}
#' \item{logo}{An optional list. Information about the logo to be included in the tables.}
#' Includes:
#' \itemize{
#' \item{\code{file} The path to a PNG file that should be used for the logo. Include the extension (.png) for an Excel theme. Exclude the extension for a Latex theme }
#' \item{\code{dpi} In Excel, a numeric. The image resolution used for conversion between units. Defaults to 300.}
#' \item{\code{height} In Excel, a numeric. The height of the logo. Defaults to 2.}
#' \item{\code{width} In Excel, a numeric. The width of the logo. Defaults to 4.}
#' \item{\code{startCol} In Excel, a numeric. The column coordinate of upper left corner of the logo. Defaults to 1.}
#' \item{\code{startRow} In Excel, a numeric. The row coordinate of upper left corner of the logo. Defaults to 1.}
#' \item{\code{units} In Excel, a character. Units of width and height. Valid options are: "cm", "in", and "px." Defaults to "in".}
#' }
#' \item{one_per_sheet}{A logical. Should each question be on its own sheet/page? Defaults to FALSE.}
#' }
#'
#' \subsection{Subarguments}{
#' \describe{
#' \item{background_color}{In Excel, an optional color. Cell background color.}
#' \item{border_bottom}{In Excel, an optional logical. Should there be a border on the bottom? }
#' \item{border_color}{In Excel, an optional color. The border color of the relevant cells.}
#' \item{border_left}{In Excel, an optional logical. Should there be a border on the left of the relevant cells? }
#' \item{border_right}{In Excel, an optional logical. Should there be a border on the right of the relevant cells? }
#' \item{border_style}{In Excel, an optional character. The style of the border of the relevant cells. Valid options are: "dashDot", "dashDotDot", "dashed", "dotted", "double", "hair", "medium", "mediumDashDot", "mediumDashDotDot", "mediumDashed", "none", "slantDashDot", "thick", and "thin".}
#' \item{border_top}{In Excel, an optional logical. Should there be a border on the top of the relevant cells? }
#' \item{decoration}{An optional character vector. Text decorations to be applied to relevant cells. Valid options are: "bold", "italic", "strikeout", "underline", and "underline2".}
#' \item{font}{An optional character. The font to be used.}
#' \item{font_color}{In Excel, an optional color. The color of the font.}
#' \item{font_size}{An optional numeric. The size of the font.}
#' \item{halign}{In Excel, an optional character. The horizontal alignment of the text. Valid options are: "center", "left", and "right".}
#' \item{include_alias}{A logical. Should the alias of the variable be included with the other information? Defaults to FALSE.}
#' \item{include_q_number}{A logical. Should the question number be included with the other information? Defaults to FALSE.}
#' \item{latex_add_parenthesis}{In Latex, a logical. Should parenthesis be added surrounding the values? Defaults to FALSE.}
#' \item{latex_adjust}{In Latex, an optional character. How should the values be adjusted? Can be missing.}
#' \item{name}{A character. The name to be used for the relevant row(s).}
#' \item{position_bottom}{In Excel, a logical. Should the relevant row(s) be at the bottom of each table? Defaults to TRUE.}
#' \item{position_fixed}{In Excel, a logical. Should the relevant row(s) be fixed at the top of the file with the banner? Defaults to FALSE.}
#' \item{position_top}{In Excel, a logical. Should should the relevant row(s) be at the top of each table? Defaults to FALSE.}
#' \item{repeat_for_subs}{A logical. Should the information be repeated for each subvariable? Defaults to TRUE.}
#' \item{pagebreak_in_banner}{A logical. Allow a banner to be broken midway across pages. Defaults to TRUE. If FALSE, Pushes the page breaking banner sub-table to the next page similar to manually using clearpage}
#' \item{valign}{In Excel, an optional character. The vertical alignment of the text. Valid options are: "bottom", "center", and "top".}
#' \item{wrap_text}{In Excel, an optional logical. Should the text wrap if it extends beyond the width of the cell? Defaults to TRUE.}
#' }
#' }
#'
#' @param ... Named arguments that specify the various output types. See the Theme Arguments section below for a complete listing.
#' @param default_theme a theme object to use for defaults if you're modifying an already existing themes
#'
#' @export
#' @importFrom utils modifyList
themeNew <- function(..., default_theme = themeDefaultExcel()) {
wrong_class_error(default_theme, "Theme", "default_theme")
# will not pass cyclomatic complexity
dots <- list(...)
if (any(names(dots) == "")) {
stop("All arguments must have a name.")
}
for (nm in setdiff(names(dots), names(default_theme))) {
if (length(unlist(validators_to_use[[nm]]["include"])) > 1) {
default_theme[[nm]] <- list()
for (incl in setdiff(validators_to_use[[nm]]$include, dots[[nm]])) {
if (as.logical(validators_to_use[[incl]]["missing"])) {
next
} else if (incl %in% names(default_theme)) {
default_theme[[nm]][[incl]] <- default_theme[[incl]]
} else if (!is.null(validators_to_use[[incl]]["default"]) &&
!is.na(validators_to_use[[incl]]["default"])) {
rsp <- unlist(validators_to_use[[incl]]["default"])
if (validators_to_use[[incl]]["class"] %in% "logical") {
default_theme[[nm]][[incl]] <- as.logical(rsp)
}
else if (validators_to_use[[incl]]["class"] %in% "numeric") {
default_theme[[nm]][[incl]] <- as.numeric(rsp)
}
else {
default_theme[[nm]][[incl]] <- rsp
}
} else if (incl %in% "name") {
default_theme[[nm]][[incl]] <- gsub(
"(^|[[:space:]])([[:alpha:]])", "\\1\\U\\2",
gsub("_", " ", gsub("format_", "", nm)),
perl = TRUE
)
} else {
print(paste(nm, incl))
}
}
}
}
theme <- modifyList(default_theme, dots, keep.null = TRUE)
theme <- theme[union(names(dots), names(default_theme))]
if (theme$latex_headtext %in% "tbc") theme$latex_headtext <- "continued from previous page"
if (theme$latex_foottext %in% "tbc") theme$latex_foottext <- "continued on the next page \\dots"
theme_validator(theme)
class(theme) <- "Theme"
return(theme)
}
#' Generate default Theme for `writeExcel`
#'
#' \code{themeDefaultExcel} is the default theme. Users can change base options
#'
#' @param font the font to use (default: Calibri)
#' @param font_size the font size to use (default: 12)
#' @param font_color the color of the type (default: black)
#' @param valign the alignment to use in cells (default: center)
#'
#' @return A set of theme defaults for use in `writeExcel`
#'
#' @export
themeDefaultExcel <- function(
font = getOption("font", default = "Calibri"),
font_size = getOption("font_size", default = 12),
font_color = getOption("font_color", default = "black"),
valign = getOption("valign", default = "center")) {
fn <- font
fs <- font_size
fc <- font_color
va <- valign
norm_maker <- function(font = fn, font_size = fs,
font_color = fc, decoration = NULL, valign = va, wrap_text = TRUE,
border_style = "thin", border_color = "black", border_top = FALSE,
border_bottom = FALSE, border_left = FALSE, border_right = FALSE) {
list(
font = font, font_size = font_size, font_color = font_color,
decoration = decoration, valign = valign, wrap_text = wrap_text,
border_style = border_style, border_color = border_color,
border_top = border_top, border_bottom = border_bottom,
border_left = border_left, border_right = border_right
)
}
position_list <- list(position_top = FALSE, position_bottom = TRUE)
var_incl <- function(include_alias = FALSE, include_q_number = FALSE,
repeat_for_subs = TRUE) {
list(
include_alias = include_alias, include_q_number = include_q_number,
repeat_for_subs = repeat_for_subs
)
}
defaults <- list(
font = font, font_size = fs, font_color = font_color, valign = valign, halign = "center",
format_title = norm_maker(font_size = fs + 4, decoration = "bold"),
format_subtitle = norm_maker(font_size = fs + 2, decoration = "bold"),
format_banner_names = c(norm_maker(border_bottom = TRUE, decoration = "bold"),
halign = "center"
),
format_banner_categories = c(norm_maker(decoration = "bold"), halign = "center"),
format_var_name = c(norm_maker(decoration = "bold"), var_incl(include_q_number = TRUE),
halign = "left"
),
format_var_subname = c(norm_maker(decoration = "bold"),
unlist(var_incl(repeat_for_subs = NULL)),
halign = "left"
),
format_var_description = c(norm_maker(font_color = "#444444"), var_incl(), halign = "left"),
format_var_filtertext = c(norm_maker(decoration = "italic"), var_incl(), halign = "left"),
format_label_column = c(norm_maker(), col_width = 40, halign = "right", extend_borders = TRUE),
format_subtotals = norm_maker(decoration = "bold"),
format_headers = norm_maker(decoration = "bold"),
format_means = c(name = "Mean", norm_maker(decoration = "bold"), position_list),
format_medians = c(name = "Median", norm_maker(decoration = "bold"), position_list),
format_unweighted_n = c(
name = "Unweighted N", norm_maker(decoration = "bold"), position_list,
position_fixed = FALSE, halign = "center",
latex_add_parenthesis = TRUE
),
format_totals_row = c(
name = "Totals", norm_maker(border_top = TRUE, decoration = "bold"),
position_list, halign = "center"
),
format_totals_column = norm_maker(),
excel_show_grid_lines = FALSE,
excel_orientation = "portrait",
excel_freeze_column = 1,
excel_percent_sign = TRUE,
digits = 0,
digits_numeric = 2,
one_per_sheet = FALSE,
latex_round_percentages = TRUE,
enforce_onehundred = FALSE,
latex_headtext = "",
latex_foottext = "",
latex_page_numbers = TRUE,
latex_table_align = "r",
latex_multirowheaderlines = TRUE,
latex_flip_grids = FALSE,
latex_max_lines_for_tabular = 0
)
class(defaults) <- "Theme"
return(defaults)
}
#' Generate default Theme for `writeLatex`
#'
#' \code{themeDefaultLatex} is the default theme. Users can change base options
#'
#' @param font the font to use (default: `"helvet"` for Helvetica)
#' @param font_size the font size to use (default: 12)
#'
#' @return A set of theme defaults for use in `writeLatex`
#'
#' @export
themeDefaultLatex <- function(font = getOption("font", default = "helvet"),
font_size = getOption("font_size", default = 12)) {
norm <- list(font = font, font_size = NULL)
defaults <- list(
font = font, font_size = font_size,
format_title = list(font_size = font_size + 4, decoration = "bold"),
format_subtitle = list(font_size = font_size, decoration = "bold"),
format_banner_categories = norm,
format_var_description = c(norm,
include_alias = FALSE,
include_q_number = TRUE, repeat_for_subs = TRUE
),
format_var_subname = c(norm, include_alias = FALSE, include_q_number = FALSE),
format_var_filtertext = list(
font_size = font_size - 4, decoration = "italic",
include_alias = FALSE, include_q_number = FALSE, repeat_for_subs = TRUE
),
format_subtotals = c(norm, decoration = "bold"),
format_headers = c(norm, decoration = "bold"),
format_unweighted_n = c(norm,
name = "Unweighted N",
position_top = FALSE, position_bottom = TRUE, position_fixed = FALSE,
latex_add_parenthesis = FALSE, latex_adjust = "c"
),
format_totals_row = c(norm,
name = "Totals",
position_top = FALSE, position_bottom = TRUE
),
format_label_column = c(norm, col_width = NA_real_, extend_borders = FALSE),
format_totals_column = norm,
digits = 0,
digits_numeric = 2,
one_per_sheet = TRUE,
excel_percent_sign = TRUE,
excel_show_grid_lines = FALSE,
excel_freeze_column = 0,
excel_orientation = "portrait",
latex_round_percentages = FALSE,
enforce_onehundred = FALSE,
latex_headtext = "",
latex_foottext = "",
latex_table_align = "r",
latex_multirowheaderlines = TRUE,
latex_max_lines_for_tabular = 0,
latex_page_numbers = TRUE,
latex_flip_grids = FALSE,
pagebreak_in_banner = TRUE
)
class(defaults) <- "Theme"
return(defaults)
}
# nolint start
theme_validators <- list(
"find_validator" = function(value, name) {
validator <- validators_to_use[[tail(name, 1)]]
if (!as.logical(validator["missing"]) && is.null(value)) {
return(theme_validators$null_error(name))
} else if (is.null(value)) {
return(NULL)
} else if (is.list(validator)) {
if ("include" %in% names(validator)) {
if (!is.list(value)) {
return(
theme_validators$class_error(
value, "list", name,
as.logical(validator["missing"])
)
)
}
return(sapply(validator$include, function(nm) {
return(theme_validators$find_validator(value[[nm]], c(name, nm)))
}))
}
return(theme_validators$valid_values(value, name, validator))
}
if (!is.na(validator["len"]) && length(value) != as.numeric(validator["len"])) {
return(theme_validators$length_error(
value, validator["len"], name,
validator["missing"]
))
}
if (is.integer(value)) {
value <- as.numeric(value)
}
if (validator["class"] %in% "color") {
return(theme_validators$color(value, name))
} else if (class(value) != validator["class"]) {
return(theme_validators$class_error(
value, validator["class"], name,
validator["missing"]
))
}
},
"class_error" = function(value, expected_class, name, missing) {
return(paste0(
"`", paste0(name, collapse = ":"), "`",
if (as.logical(missing)) ", if provided,", " must be of class ",
expected_class, ", not ", collapse_items(class(value)), "."
))
},
"null_error" = function(name) {
return(paste0(
"`", paste0(name, collapse = ":"),
"` must have a value. It cannot be `NULL`."
))
},
"length_error" = function(value, len, name, missing) {
return(paste0(
"`", paste0(name, collapse = ":"), "`",
if (as.logical(missing)) ", if provided,", " must have length ",
len, ", not ", length(value), "."
))
},
"valid_values" = function(value, name, validator) {
if (!validator$mult && length(value) != 1) {
return(theme_validators$length_error(value, 1, name, validator["missing"]))
} else if (class(value) != "character") {
return(theme_validators$class_error(value, "character", name, validator["missing"]))
} else if (!all(tolower(value) %in% tolower(validator$valid))) {
vals <- paste0("'", validator$valid, "'", collapse = ", ")
if (nchar(vals) > 100) vals <- paste0(substr(vals, 1, 100), "...")
return(paste0(
"`", paste0(name, collapse = ":"), "`",
if (as.logical(validator["missing"])) ", if provided,", " must be in ",
vals, ", not ", paste0("'", value, "'", collapse = ", "), "."
))
}
},
"color" = function(value, name) {
if (class(value) != "character") {
return(theme_validators$class_error(value, "character", name, TRUE))
} else if (!(value %in% colors() | grepl("^#(\\d|[a-f]){6,8}$", value, ignore.case = TRUE))) {
return(paste0("`", paste0(name, collapse = ":"), "` must be a color."))
}
}
)
# nolint end
norm <- list(
"font", "font_size", "font_color", "background_color", "valign",
"halign", "wrap_text", "decoration", "font_size", "border_style",
"border_color", "border_top", "border_bottom", "border_left", "border_right"
)
validators_to_use <- list(
background_color = c(class = "color", len = 1, missing = TRUE),
format_banner_split = list(
missing = TRUE,
include = list("border_style", "border_color", "empty_col")
),
border_color = c(class = "color", len = 1, missing = TRUE),
border_style = list(
mult = FALSE, missing = TRUE,
valid = list(
"none", "thin", "medium", "dashed", "dotted", "thick",
"double", "hair", "mediumDashed", "dashDot", "mediumDashDot", "dashDotDot",
"mediumDashDotDot", "slantDashDot"
)
),
border_top = c(class = "logical", len = 1, missing = TRUE),
border_bottom = c(class = "logical", len = 1, missing = TRUE),
border_left = c(class = "logical", len = 1, missing = TRUE),
border_right = c(class = "logical", len = 1, missing = TRUE),
col_width = c(class = "numeric", len = 1, missing = FALSE, default = 40),
decoration = list(
mult = TRUE, missing = TRUE,
valid = list("bold", "strikeout", "italic", "underline", "underline2")
),
digits = c(class = "numeric", len = 1, missing = FALSE, default = 0),
digits_numeric = c(class = "numeric", len = 1, missing = FALSE, default = 2),
digits_final = c(class = "numeric", len = 1, missing = TRUE),
dpi = c(class = "numeric", len = 1, missing = FALSE, default = 300),
empty_col = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
extend_borders = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
file = c(class = "character", len = 1, missing = TRUE),
font = c(class = "character", len = 1, missing = TRUE),
font_color = c(class = "color", len = 1, missing = TRUE),
font_size = c(class = "numeric", len = 1, missing = TRUE),
excel_footer = c(class = "character", len = 3, missing = TRUE),
format_banner_categories = list(missing = FALSE, include = norm),
format_banner_names = list(missing = TRUE, include = norm),
format_title = list(missing = TRUE, include = norm),
format_headers = list(missing = TRUE, include = norm),
format_label_column = list(
missing = TRUE,
include = c(norm, "col_width", "extend_borders")
),
format_label_column_exceptions = c(class = "numeric", len = NA, missing = TRUE),
format_means = list(
missing = TRUE,
include = c(norm, "name", "position_top", "position_bottom")
),
format_medians = list(
missing = TRUE,
include = c(norm, "name", "position_top", "position_bottom")
),
format_min_base = list(missing = TRUE, include = c(norm, "min_base", "mask")),
format_subtitle = list(missing = TRUE, include = norm),
format_subtotals = list(missing = TRUE, include = norm),
format_totals_column = list(missing = FALSE, include = norm),
format_totals_row = list(
missing = TRUE,
include = c("name", norm, "position_top", "position_bottom")
),
format_unweighted_n = list(
missing = TRUE,
include = c("name", norm, "position_top", "position_bottom", "position_fixed")
),
format_var_alias = list(missing = TRUE, include = c(norm, "include_q_number")),
format_var_name = list(
missing = TRUE,
include = c(norm, "include_alias", "repeat_for_subs", "include_q_number")
),
format_var_description = list(
missing = TRUE,
include = c(norm, "include_alias", "repeat_for_subs", "include_q_number")
),
format_var_subname = list(
missing = TRUE,
include = c(norm, "include_alias", "include_q_number")
),
format_var_filtertext = list(
missing = TRUE,
include = c(norm, "include_alias", "repeat_for_subs", "include_q_number")
),
format_weighted_n = list(
missing = TRUE,
include = c("name", norm, "position_top", "position_bottom", "position_fixed")
),
excel_freeze_column = c(class = "numeric", len = 1, missing = FALSE, default = 1),
halign = list(mult = FALSE, missing = TRUE, valid = list("left", "right", "center")),
excel_header = c(class = "character", len = 3, missing = TRUE),
height = c(class = "numeric", len = 1, missing = FALSE, default = 2),
include_alias = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
include_q_number = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_add_parenthesis = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_adjust = c(class = "character", len = 1, missing = TRUE),
latex_foottext = c(class = "character", len = 1, missing = FALSE, default = ""),
latex_headtext = c(class = "character", len = 1, missing = FALSE, default = ""),
latex_max_lines_for_tabular = c(class = "numeric", len = 1, missing = FALSE, default = 0),
latex_multirowheaderlines = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_round_percentages = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_round_percentages_exception = c(class = "character", len = NA, missing = TRUE),
enforce_onehundred = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_table_align = c(class = "character", len = 1, missing = FALSE, default = ""),
latex_flip_grids = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
latex_flip_specific_grids = c(class = "character", len = NA, missing = TRUE),
latex_page_numbers = c(class = "logical", len = 1, missing = FALSE, default = TRUE),
logo = list(missing = TRUE, include = list(
"file", "startRow", "startCol",
"width", "height", "units", "dpi"
)),
mask = c(class = "character", len = 1, missing = TRUE),
min_base = c(class = "numeric", len = 1, missing = TRUE),
name = c(class = "character", len = 1, missing = FALSE),
one_per_sheet = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
excel_orientation = list(
mult = FALSE, missing = FALSE,
valid = list("portrait", "landscape"), default = "landscape"
),
excel_percent_sign = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
position_bottom = c(class = "logical", len = 1, missing = FALSE, default = TRUE),
position_fixed = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
position_top = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
repeat_for_subs = c(class = "logical", len = 1, missing = FALSE, default = TRUE),
pagebreak_in_banner = c(class = "logical", len = 1, missing = TRUE, default = TRUE),
excel_show_grid_lines = c(class = "logical", len = 1, missing = FALSE, default = FALSE),
startCol = c(class = "numeric", len = 1, missing = FALSE, default = 1),
startRow = c(class = "numeric", len = 1, missing = FALSE, default = 1),
excel_table_border = list(missing = TRUE, include = list("border_style", "border_color")),
units = list(mult = FALSE, missing = FALSE, valid = list("in", "cm", "px"), default = "in"),
valign = list(mult = FALSE, missing = TRUE, valid = list("top", "bottom", "center")),
width = c(class = "numeric", len = 1, missing = FALSE, default = 4),
wrap_text = c(class = "logical", len = 1, missing = TRUE, default = TRUE)
)
#' Theme Validator
#'
#' Validates a theme.
#'
#' @param theme An object from \link{themeNew}
theme_validator <- function(theme) {
theme_required <- c(
"digits", "digits_numeric", "digits_final", "excel_footer",
"excel_freeze_column", "excel_header", "excel_orientation",
"excel_percent_sign", "excel_show_grid_lines", "excel_table_border",
"font", "font_color", "font_size", "format_banner_categories",
"format_banner_names", "format_banner_split", "format_headers",
"format_label_column", "format_label_column_exceptions", "format_means",
"format_medians", "format_min_base",
"format_subtitle", "format_subtotals", "format_title",
"format_totals_column", "format_totals_row", "format_unweighted_n",
"format_var_alias", "format_var_description", "format_var_filtertext",
"format_var_name", "format_var_subname", "format_weighted_n", "halign",
"latex_foottext", "latex_headtext", "latex_max_lines_for_tabular",
"latex_multirowheaderlines", "latex_round_percentages", "enforce_onehundred",
"latex_flip_grids", "latex_round_percentages_exception", "latex_page_numbers",
"latex_table_align", "logo", "one_per_sheet", "valign", "pagebreak_in_banner",
"latex_flip_specific_grids"
)
ignore <- setdiff(names(theme), theme_required)
if (length(ignore) > 0) {
warning(
"Arguments: ", collapse_items(ignore),
" are not supported in themeNew and will be ignored."
)
}
errors <- unlist(sapply(theme_required, function(name) {
theme_validators$find_validator(theme[[name]], name)
}))
if (is.numeric(theme$digits) && theme$digits > 20) {
errors <- c(errors, "`digits` must be less than 20.")
}
if (length(errors) != 0) {
if (length(errors) > 5) {
stop("\n", paste0(errors[1:5], collapse = "\n"),
"\nAnd ", length(errors) - 5, " more errors.",
call. = FALSE
)
}
stop("\n", paste0(errors, collapse = "\n"), call. = FALSE)
}
# Issue 88
if ("logo" %in% names(theme)) {
# Check if version of logo exists:
wo_png <- file.exists(paste0(theme$logo$file, ".png"))
w_png <- file.exists(paste0(theme$logo$file))
if (!(wo_png | w_png)) {
stop("Logo file not found, check path to file or current working directory.")
}
}
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.