Nothing
#' Get, set and update themes.
#'
#' Use \code{theme_get} to get the current theme, and \code{theme_set} to
#' completely override it. \code{theme_update} and \code{theme_replace} are
#' shorthands for changing individual elements in the current theme.
#' \code{theme_update} uses the \code{+} operator, so that any unspecified
#' values in the theme element will default to the values they are set in the
#' theme. \code{theme_replace} will completely replace the element, so any
#' unspecified values will overwrite the current value in the theme with \code{NULL}s.
#'
#'
#' @param ... named list of theme settings
#' @seealso \code{\link{\%+replace\%}}
#' @export
#' @examples
#' p <- ggplot(mtcars, aes(mpg, wt)) +
#' geom_point()
#' p
#' old <- theme_set(theme_bw())
#' p
#' theme_set(old)
#' p
#'
#' #theme_replace NULLs out the fill attribute of panel.background,
#' #resulting in a white background:
#' theme_get()$panel.background
#' old <- theme_replace(panel.background = element_rect(colour = "pink"))
#' theme_get()$panel.background
#' p
#' theme_set(old)
#'
#' #theme_update only changes the colour attribute, leaving the others intact:
#' old <- theme_update(panel.background = element_rect(colour = "pink"))
#' theme_get()$panel.background
#' p
#' theme_set(old)
#'
#' theme_get()
#'
#'
#' ggplot(mtcars, aes(mpg, wt)) +
#' geom_point(aes(color = mpg)) +
#' theme(legend.position = c(0.95, 0.95),
#' legend.justification = c(1, 1))
#' last_plot() +
#' theme(legend.background = element_rect(fill = "white", colour = "white", size = 3))
#'
theme_update <- function(...) {
theme_set(theme_get() + theme(...))
}
#' @rdname theme_update
#' @export
theme_replace <- function(...) {
theme_set(theme_get() %+replace% theme(...))
}
#' Reports whether x is a theme object
#' @param x An object to test
#' @export
is.theme <- function(x) inherits(x, "theme")
#' @export
print.theme <- function(x, ...) utils::str(x)
#' Set theme elements
#'
#'
#' Use this function to modify theme settings.
#'
#' Theme elements can inherit properties from other theme elements.
#' For example, \code{axis.title.x} inherits from \code{axis.title},
#' which in turn inherits from \code{text}. All text elements inherit
#' directly or indirectly from \code{text}; all lines inherit from
#' \code{line}, and all rectangular objects inherit from \code{rect}.
#'
#' For more examples of modifying properties using inheritance,
#' \code{\link{\%+replace\%}}.
#'
#' To see a graphical representation of the inheritance tree, see the
#' last example below.
#'
#' @section Theme elements:
#' The individual theme elements are:
#'
#' \tabular{ll}{
#' line \tab all line elements
#' (\code{element_line}) \cr
#' rect \tab all rectangular elements
#' (\code{element_rect}) \cr
#' text \tab all text elements
#' (\code{element_text}) \cr
#' title \tab all title elements: plot, axes, legends
#' (\code{element_text}; inherits from \code{text}) \cr
#' aspect.ratio \tab aspect ratio of the panel \cr
#'
#' axis.title \tab label of axes
#' (\code{element_text}; inherits from \code{text}) \cr
#' axis.title.x \tab x axis label
#' (\code{element_text}; inherits from \code{axis.title}) \cr
#' axis.title.y \tab y axis label
#' (\code{element_text}; inherits from \code{axis.title}) \cr
#' axis.text \tab tick labels along axes
#' (\code{element_text}; inherits from \code{text}) \cr
#' axis.text.x \tab x axis tick labels
#' (\code{element_text}; inherits from \code{axis.text}) \cr
#' axis.text.y \tab y axis tick labels
#' (\code{element_text}; inherits from \code{axis.text}) \cr
#' axis.ticks \tab tick marks along axes
#' (\code{element_line}; inherits from \code{line}) \cr
#' axis.ticks.x \tab x axis tick marks
#' (\code{element_line}; inherits from \code{axis.ticks}) \cr
#' axis.ticks.y \tab y axis tick marks
#' (\code{element_line}; inherits from \code{axis.ticks}) \cr
#' axis.ticks.length \tab length of tick marks
#' (\code{unit}) \cr
#' axis.line \tab lines along axes
#' (\code{element_line}; inherits from \code{line}) \cr
#' axis.line.x \tab line along x axis
#' (\code{element_line}; inherits from \code{axis.line}) \cr
#' axis.line.y \tab line along y axis
#' (\code{element_line}; inherits from \code{axis.line}) \cr
#'
#' legend.background \tab background of legend
#' (\code{element_rect}; inherits from \code{rect}) \cr
#' legend.margin \tab extra space added around legend
#' (\code{unit}) \cr
#' legend.key \tab background underneath legend keys
#' (\code{element_rect}; inherits from \code{rect}) \cr
#' legend.key.size \tab size of legend keys
#' (\code{unit}; inherits from \code{legend.key.size}) \cr
#' legend.key.height \tab key background height
#' (\code{unit}; inherits from \code{legend.key.size}) \cr
#' legend.key.width \tab key background width
#' (\code{unit}; inherits from \code{legend.key.size}) \cr
#' legend.text \tab legend item labels
#' (\code{element_text}; inherits from \code{text}) \cr
#' legend.text.align \tab alignment of legend labels
#' (number from 0 (left) to 1 (right)) \cr
#' legend.title \tab title of legend
#' (\code{element_text}; inherits from \code{title}) \cr
#' legend.title.align \tab alignment of legend title
#' (number from 0 (left) to 1 (right)) \cr
#' legend.position \tab the position of legends
#' ("none", "left", "right", "bottom", "top", or two-element
#' numeric vector) \cr
#' legend.direction \tab layout of items in legends
#' ("horizontal" or "vertical") \cr
#' legend.justification \tab anchor point for positioning legend inside plot
#' ("center" or two-element numeric vector) \cr
#' legend.box \tab arrangement of multiple legends
#' ("horizontal" or "vertical") \cr
#' legend.box.just \tab justification of each legend within the overall
#' bounding box, when there are multiple legends
#' ("top", "bottom", "left", or "right")\cr
#'
#' panel.background \tab background of plotting area, drawn underneath plot
#' (\code{element_rect}; inherits from \code{rect}) \cr
#' panel.border \tab border around plotting area, drawn on top of plot
#' so that it covers tick marks and grid lines. This should
#' be used with \code{fill=NA}
#' (\code{element_rect}; inherits from \code{rect}) \cr
#' panel.margin \tab margin around facet panels
#' (\code{unit}) \cr
#' panel.margin.x \tab horizontal margin around facet panels
#' (\code{unit}; inherits from \code{panel.margin}) \cr
#' panel.margin.y \tab vertical margin around facet panels
#' (\code{unit}; inherits from \code{panel.margin}) \cr
#' panel.grid \tab grid lines
#' (\code{element_line}; inherits from \code{line}) \cr
#' panel.grid.major \tab major grid lines
#' (\code{element_line}; inherits from \code{panel.grid}) \cr
#' panel.grid.minor \tab minor grid lines
#' (\code{element_line}; inherits from \code{panel.grid}) \cr
#' panel.grid.major.x \tab vertical major grid lines
#' (\code{element_line}; inherits from \code{panel.grid.major}) \cr
#' panel.grid.major.y \tab horizontal major grid lines
#' (\code{element_line}; inherits from \code{panel.grid.major}) \cr
#' panel.grid.minor.x \tab vertical minor grid lines
#' (\code{element_line}; inherits from \code{panel.grid.minor}) \cr
#' panel.grid.minor.y \tab horizontal minor grid lines
#' (\code{element_line}; inherits from \code{panel.grid.minor}) \cr
#' panel.ontop \tab option to place the panel (background, gridlines)
#' over the data layers. Usually used with a transparent
#' or blank \code{panel.background}. (\code{logical}) \cr
#'
#' plot.background \tab background of the entire plot
#' (\code{element_rect}; inherits from \code{rect}) \cr
#' plot.title \tab plot title (text appearance)
#' (\code{element_text}; inherits from \code{title})
#' left-aligned by default\cr
#' plot.subtitle \tab plot subtitle (text appearance)
#' (\code{element_text}; inherits from \code{title})
#' left-aligned by default\cr
#' plot.caption \tab caption below the plot (text appearance)
#' (\code{element_text}; inherits from \code{title})
#' right-aligned by default\cr
#' plot.margin \tab margin around entire plot
#' (\code{unit} with the sizes of the top, right, bottom, and
#' left margins) \cr
#'
#' strip.background \tab background of facet labels
#' (\code{element_rect}; inherits from \code{rect}) \cr
#' strip.text \tab facet labels
#' (\code{element_text}; inherits from \code{text}) \cr
#' strip.text.x \tab facet labels along horizontal direction
#' (\code{element_text}; inherits from \code{strip.text}) \cr
#' strip.text.y \tab facet labels along vertical direction
#' (\code{element_text}; inherits from \code{strip.text}) \cr
#' strip.switch.pad.grid \tab space between strips and axes when strips are switched
#' (\code{unit}) \cr
#' strip.switch.pad.wrap \tab space between strips and axes when strips are switched
#' (\code{unit}) \cr
#' }
#'
#' @param ... a list of element name, element pairings that modify the
#' existing theme.
#' @param complete set this to TRUE if this is a complete theme, such as
#' the one returned \code{by theme_grey()}. Complete themes behave
#' differently when added to a ggplot object.
#' @param validate TRUE to run validate_element, FALSE to bypass checks.
#'
#' @seealso \code{\link{\%+replace\%}}
#' @seealso \code{\link{rel}}
#' @seealso \code{\link{element_blank}}
#' @seealso \code{\link{element_line}}
#' @seealso \code{\link{element_rect}}
#' @seealso \code{\link{element_text}}
#' @export
#' @examples
#' \donttest{
#' p <- ggplot(mtcars, aes(mpg, wt)) +
#' geom_point()
#' p
#' p + theme(panel.background = element_rect(colour = "pink"))
#' p + theme_bw()
#'
#' # Scatter plot of gas mileage by vehicle weight
#' p <- ggplot(mtcars, aes(wt, mpg)) +
#' geom_point()
#' # Calculate slope and intercept of line of best fit
#' coef(lm(mpg ~ wt, data = mtcars))
#' p + geom_abline(intercept = 37, slope = -5)
#' # Calculate correlation coefficient
#' with(mtcars, cor(wt, mpg, use = "everything", method = "pearson"))
#' #annotate the plot
#' p + geom_abline(intercept = 37, slope = -5) +
#' geom_text(data = data.frame(), aes(4.5, 30, label = "Pearson-R = -.87"))
#'
#' # Change the axis labels
#' # Original plot
#' p
#' p + labs(x = "Vehicle Weight", y = "Miles per Gallon")
#' # Or
#' p + labs(x = "Vehicle Weight", y = "Miles per Gallon")
#'
#' # Change title appearance
#' p <- p + labs(title = "Vehicle Weight-Gas Mileage Relationship")
#' # Set title to twice the base font size
#' p + theme(plot.title = element_text(size = rel(2)))
#' p + theme(plot.title = element_text(size = rel(2), colour = "blue"))
#'
#' # Add a subtitle and adjust bottom margin
#' p + labs(title = "Vehicle Weight-Gas Mileage Relationship",
#' subtitle = "You need to wrap long subtitleson manually") +
#' theme(plot.subtitle = element_text(margin = margin(b = 20)))
#'
#' # Changing plot look with themes
#' DF <- data.frame(x = rnorm(400))
#' m <- ggplot(DF, aes(x = x)) +
#' geom_histogram()
#' # Default is theme_grey()
#' m
#' # Compare with
#' m + theme_bw()
#'
#' # Manipulate Axis Attributes
#' m + theme(axis.line = element_line(size = 3, colour = "red", linetype = "dotted"))
#' m + theme(axis.text = element_text(colour = "blue"))
#' m + theme(axis.text.y = element_blank())
#' m + theme(axis.ticks = element_line(size = 2))
#' m + theme(axis.title.y = element_text(size = rel(1.5), angle = 90))
#' m + theme(axis.title.x = element_blank())
#' m + theme(axis.ticks.length = unit(.85, "cm"))
#'
#' # Legend Attributes
#' z <- ggplot(mtcars, aes(wt, mpg)) +
#' geom_point(aes(colour = factor(cyl)))
#' z
#' z + theme(legend.position = "none")
#' z + theme(legend.position = "bottom")
#' # Or use relative coordinates between 0 and 1
#' z + theme(legend.position = c(.5, .5))
#' # Add a border to the whole legend
#' z + theme(legend.background = element_rect(colour = "black"))
#' # Legend margin controls extra space around outside of legend:
#' z + theme(legend.background = element_rect(),
#' legend.margin = unit(1, "cm"))
#' z + theme(legend.background = element_rect(),
#' legend.margin = unit(0, "cm"))
#' # Or to just the keys
#' z + theme(legend.key = element_rect(colour = "black"))
#' z + theme(legend.key = element_rect(fill = "yellow"))
#' z + theme(legend.key.size = unit(2.5, "cm"))
#' z + theme(legend.text = element_text(size = 20, colour = "red", angle = 45))
#' z + theme(legend.title = element_text(face = "italic"))
#'
#' # To change the title of the legend use the name argument
#' # in one of the scale options
#' z + scale_colour_brewer(name = "My Legend")
#' z + scale_colour_grey(name = "Number of \nCylinders")
#'
#' # Panel and Plot Attributes
#' z + theme(panel.background = element_rect(fill = "black"))
#' z + theme(panel.border = element_rect(linetype = "dashed", colour = "black"))
#' z + theme(panel.grid.major = element_line(colour = "blue"))
#' z + theme(panel.grid.minor = element_line(colour = "red", linetype = "dotted"))
#' z + theme(panel.grid.major = element_line(size = 2))
#' z + theme(panel.grid.major.y = element_blank(),
#' panel.grid.minor.y = element_blank())
#' z + theme(plot.background = element_rect())
#' z + theme(plot.background = element_rect(fill = "green"))
#'
#' # Faceting Attributes
#' set.seed(4940)
#' dsmall <- diamonds[sample(nrow(diamonds), 1000), ]
#' k <- ggplot(dsmall, aes(carat, ..density..)) +
#' geom_histogram(binwidth = 0.2) +
#' facet_grid(. ~ cut)
#' k + theme(strip.background = element_rect(colour = "purple", fill = "pink",
#' size = 3, linetype = "dashed"))
#' k + theme(strip.text.x = element_text(colour = "red", angle = 45, size = 10,
#' hjust = 0.5, vjust = 0.5))
#' k + theme(panel.margin = unit(5, "lines"))
#' k + theme(panel.margin.y = unit(0, "lines"))
#'
#' # Put gridlines on top
#' meanprice <- tapply(diamonds$price, diamonds$cut, mean)
#' cut <- factor(levels(diamonds$cut), levels = levels(diamonds$cut))
#' df <- data.frame(meanprice, cut)
#' g <- ggplot(df, aes(cut, meanprice)) + geom_bar(stat = "identity")
#' g + geom_bar(stat = "identity") +
#' theme(panel.background = element_blank(),
#' panel.grid.major.x = element_blank(),
#' panel.grid.minor.x = element_blank(),
#' panel.grid.minor.y = element_blank(),
#' panel.ontop = TRUE)
#'
#' # Modify a theme and save it
#' mytheme <- theme_grey() + theme(plot.title = element_text(colour = "red"))
#' p + mytheme
#'
#' }
theme <- function(..., complete = FALSE, validate = TRUE) {
elements <- list(...)
if (!is.null(elements$axis.ticks.margin)) {
warning("`axis.ticks.margin` is deprecated. Please set `margin` property ",
" of `axis.text` instead", call. = FALSE)
elements$axis.ticks.margin <- NULL
}
# Check that all elements have the correct class (element_text, unit, etc)
if (validate) {
mapply(validate_element, elements, names(elements))
}
structure(elements, class = c("theme", "gganimint"),
complete = complete, validate = validate)
}
# Combine plot defaults with current theme to get complete theme for a plot
plot_theme <- function(x) {
defaults(x$theme, theme_get())
}
.theme <- (function() {
theme <- theme_gray()
list(
get = function() theme,
set = function(new) {
missing <- setdiff(names(theme_gray()), names(new))
if (length(missing) > 0) {
warning("New theme missing the following elements: ",
paste(missing, collapse = ", "), call. = FALSE)
}
old <- theme
theme <<- new
invisible(old)
}
)
})()
#' @rdname theme_update
#' @export
theme_get <- .theme$get
#' @rdname theme_update
#' @param new new theme (a list of theme elements)
#' @export
theme_set <- .theme$set
#' @rdname gg-add
#' @export
"%+replace%" <- function(e1, e2) {
if (!is.theme(e1) || !is.theme(e2)) {
stop("%+replace% requires two theme objects", call. = FALSE)
}
# Can't use modifyList here since it works recursively and drops NULLs
e1[names(e2)] <- e2
e1
}
#' Modify properties of an element in a theme object
#'
#' @param t1 A theme object
#' @param t2 A theme object that is to be added to \code{t1}
#' @param t2name A name of the t2 object. This is used for printing
#' informative error messages.
#'
#'
add_theme <- function(t1, t2, t2name) {
if (!is.theme(t2)) {
stop("Don't know how to add ", t2name, " to a theme object",
call. = FALSE)
}
# Iterate over the elements that are to be updated
for (item in names(t2)) {
x <- t1[[item]]
y <- t2[[item]]
if (is.null(x) || inherits(x, "element_blank")) {
# If x is NULL or element_blank, then just assign it y
x <- y
} else if (is.null(y) || is.character(y) || is.numeric(y) ||
is.logical(y) || inherits(y, "element_blank")) {
# If y is NULL, or a string or numeric vector, or is element_blank, just replace x
x <- y
} else {
# If x is not NULL, then copy over the non-NULL properties from y
# Get logical vector of non-NULL properties in y
idx <- !vapply(y, is.null, logical(1))
# Get the names of TRUE items
idx <- names(idx[idx])
# Update non-NULL items
x[idx] <- y[idx]
}
# Assign it back to t1
# This is like doing t1[[item]] <- x, except that it preserves NULLs.
# The other form will simply drop NULL values
t1[item] <- list(x)
}
# If either theme is complete, then the combined theme is complete
attr(t1, "complete") <- attr(t1, "complete") || attr(t2, "complete")
t1
}
# Update a theme from a plot object
#
# This is called from add_ggplot.
#
# If newtheme is a *complete* theme, then it is meant to replace
# oldtheme; this function just returns newtheme.
#
# Otherwise, it adds elements from newtheme to oldtheme:
# If oldtheme doesn't already contain those elements,
# it searches the current default theme, grabs the elements with the
# same name as those from newtheme, and puts them in oldtheme. Then
# it adds elements from newtheme to oldtheme.
# This makes it possible to do things like:
# ggplot(data.frame(x = 1:3, y = 1:3)) +
# geom_point() + theme(text = element_text(colour = 'red'))
# and have 'text' keep properties from the default theme. Otherwise
# you would have to set all the element properties, like family, size,
# etc.
#
# @param oldtheme an existing theme, usually from a plot object, like
# plot$theme. This could be an empty list.
# @param newtheme a new theme object to add to the existing theme
update_theme <- function(oldtheme, newtheme) {
# If the newtheme is a complete one, don't bother searching
# the default theme -- just replace everything with newtheme
if (attr(newtheme, "complete"))
return(newtheme)
# These are elements in newtheme that aren't already set in oldtheme.
# They will be pulled from the default theme.
newitems <- !names(newtheme) %in% names(oldtheme)
newitem_names <- names(newtheme)[newitems]
oldtheme[newitem_names] <- theme_get()[newitem_names]
# Update the theme elements with the things from newtheme
# Turn the 'theme' list into a proper theme object first, and preserve
# the 'complete' attribute. It's possible that oldtheme is an empty
# list, and in that case, set complete to FALSE.
old.validate <- isTRUE(attr(oldtheme, "validate"))
new.validate <- isTRUE(attr(newtheme, "validate"))
oldtheme <- do.call(theme, c(oldtheme,
complete = isTRUE(attr(oldtheme, "complete")),
validate = old.validate & new.validate))
oldtheme + newtheme
}
#' Calculate the element properties, by inheriting properties from its parents
#'
#' @param element The name of the theme element to calculate
#' @param theme A theme object (like theme_grey())
#' @param verbose If TRUE, print out which elements this one inherits from
#' @examples
#' t <- theme_grey()
#' calc_element('text', t)
#'
#' # Compare the "raw" element definition to the element with calculated inheritance
#' t$axis.text.x
#' calc_element('axis.text.x', t, verbose = TRUE)
#'
#' # This reports that axis.text.x inherits from axis.text,
#' # which inherits from text. You can view each of them with:
#' t$axis.text.x
#' t$axis.text
#' t$text
#'
#' @export
calc_element <- function(element, theme, verbose = FALSE) {
if (verbose) message(element, " --> ", appendLF = FALSE)
# If this is element_blank, don't inherit anything from parents
if (inherits(theme[[element]], "element_blank")) {
if (verbose) message("element_blank (no inheritance)")
return(theme[[element]])
}
# If the element is defined (and not just inherited), check that
# it is of the class specified in .element_tree
if (!is.null(theme[[element]]) &&
!inherits(theme[[element]], .element_tree[[element]]$class)) {
stop(element, " should have class ", .element_tree[[element]]$class)
}
# Get the names of parents from the inheritance tree
pnames <- .element_tree[[element]]$inherit
# If no parents, this is a "root" node. Just return this element.
if (is.null(pnames)) {
# Check that all the properties of this element are non-NULL
nullprops <- vapply(theme[[element]], is.null, logical(1))
if (any(nullprops)) {
stop("Theme element '", element, "' has NULL property: ",
paste(names(nullprops)[nullprops], collapse = ", "))
}
if (verbose) message("nothing (top level)")
return(theme[[element]])
}
# Calculate the parent objects' inheritance
if (verbose) message(paste(pnames, collapse = ", "))
parents <- lapply(pnames, calc_element, theme, verbose)
# Combine the properties of this element with all parents
Reduce(combine_elements, parents, theme[[element]])
}
# Combine the properties of two elements
#
# @param e1 An element object
# @param e2 An element object which e1 inherits from
combine_elements <- function(e1, e2) {
# If e2 is NULL, nothing to inherit
if (is.null(e2)) return(e1)
# If e1 is NULL, or if e2 is element_blank, inherit everything from e2
if (is.null(e1) || inherits(e2, "element_blank")) return(e2)
# If e1 has any NULL properties, inherit them from e2
n <- vapply(e1[names(e2)], is.null, logical(1))
e1[n] <- e2[n]
# Calculate relative sizes
if (is.rel(e1$size)) {
e1$size <- e2$size * unclass(e1$size)
}
e1
}
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.