R/ggplot2.R
In aalfons/r2spss: Format R Output to Look Like SPSS
Defines functions
get_par_mapping
get_aes_mapping
standardize_args
substrSPSS
substr_SPSS
numberSPSS
number_SPSS
scale_fill_SPSS
scale_colour_SPSS
scale_color_SPSS
SPSS_pal
paletteSPSS
palette_SPSS
theme_SPSS
Documented in
numberSPSS
number_SPSS
paletteSPSS
palette_SPSS
scale_color_SPSS
scale_colour_SPSS
scale_fill_SPSS
SPSS_pal
substrSPSS
substr_SPSS
theme_SPSS
# --------------------------------------
# Author: Andreas Alfons
# Erasmus Universiteit Rotterdam
# --------------------------------------
#' Plot theme to mimic the look of SPSS graphs
#'
#' Complete theme that controls all non-data display of a plot to mimic the
#' look of SPSS graphs. Use \code{\link[ggplot2]{theme}} after
#' \code{theme_SPSS} to further tweak the display.
#'
#' @param base_size an integer giving the base font size in pts.
#' @param base_family a character string giving the base font family.
#' @param base_line_size base size for line elements.
#' @param base_rect_size base size for borders of rectangle elements.
#' @param version a character string specifying whether to mimic the look
#' of recent SPSS versions (\code{"modern"}) or older versions (<24;
#' \code{"legacy"}).
#' @param scales,scale.x,scale.y a character string specifying whether both
#' or each of the axes are expected to be continuous (\code{"continuous"}) or
#' discrete (\code{"discrete"}). Note that this only controls the appearance
#' of the tick labels on the axis, as the theme has no control over the
#' information that is displayed in the plot. SPSS displays larger tick
#' labels a for discrete axis than for a continuous axis, hence specifying
#' this information in the theme adjusts the tick label size accordingly.
#' The default (\code{NULL}) means that the tick labels are of the same size
#' as for a continuous axis.
#'
#' @examples
#' # data to be plotted
#' df <- data.frame(x = 1:30, y = 0)
#'
#' # initialize plot
#' p <- ggplot(aes(x = x, y = y, fill = factor(x)), data = df) +
#' geom_point(shape = 21, size = 3, show.legend = FALSE) +
#' theme_SPSS()
#'
#' # colors of modern SPSS versions
#' p + theme_SPSS() + scale_fill_SPSS()
#'
#' # colors of legacy SPSS versions
#' p + theme_SPSS(version = "legacy") +
#' scale_fill_SPSS(version = "legacy")
#'
#' @keywords aplot
#'
#' @import ggplot2
#' @export
theme_SPSS <- function(base_size = 12, base_family = "",
base_line_size = 0.5,
base_rect_size = 0.5,
version = r2spss_options$get("version"),
scales = NULL, scale.x = scales, scale.y = scales) {
# initializations
version <- match.arg(version, choices = get_version_values())
scales <- match.arg(scales, choices = get_scale_values())
scale.x <- match.arg(scale.x, choices = get_scale_values())
scale.y <- match.arg(scale.y, choices = get_scale_values())
# useful measurements
half_line <- base_size / 2
quarter_line <- half_line / 2
tiny <- 0.8 # multiplication factor to make some elements tiny
small <- 0.9 # multiplication factor to make some elements smaller
large <- 1.2 # multiplication factor to make some elements larger
# define some elements to be used in the theme
if (version == "legacy") {
ticks_length <- unit(half_line, "pt")
axis_text_margin <- tiny * quarter_line
panel_background <- element_rect(fill = "#F0F0F0", color = NA)
panel_border <- element_rect(fill = NA, color = "black")
grid_lines <- element_blank()
} else {
ticks_length <- unit(0, "pt")
axis_text_margin <- quarter_line
panel_background <- element_rect(fill = "white", color = NA)
panel_border <- element_blank()
grid_lines <- element_line(color = "#AEAEAE")
}
# define theme
theme(
# basic elements
line = element_line(color = "black", size = base_line_size,
linetype = "solid", lineend = "butt"),
rect = element_rect(fill = "white", color = "black",
size = base_rect_size, linetype = "solid"),
text = element_text(family = base_family, face = "plain", color = "black",
size = base_size, hjust = 0.5, vjust = 0.5, angle = 0,
lineheight = 0.9, margin = margin(), debug = FALSE),
title = element_text(face = "bold"),
aspect.ratio = NULL,
# axis labels
# axis.title = element_text(face = "bold"),
axis.title = NULL,
axis.title.x = element_text(vjust = 1,
margin = margin(t = half_line)),
axis.title.y = element_text(vjust = 1,
angle = 90,
margin = margin(r = half_line)),
axis.title.x.top = element_text(vjust = 0,
margin = margin(b = half_line)),
axis.title.x.bottom = NULL,
axis.title.y.left = NULL,
axis.title.y.right = element_text(vjust = 0,
angle = -90,
margin = margin(l = half_line)),
# axis tick labels
axis.text = element_text(color = "black",
size = if (scales != "discrete") rel(tiny)),
axis.text.x = element_text(size = if (scale.x == "discrete") base_size,
vjust = 1,
margin = margin(t = axis_text_margin)),
axis.text.y = element_text(size = if (scale.y == "discrete") base_size,
hjust = 1,
margin = margin(r = axis_text_margin)),
axis.text.x.top = element_text(vjust = 0,
margin = margin(b = axis_text_margin)),
axis.text.x.bottom = NULL,
axis.text.y.left = NULL,
axis.text.y.right = element_text(hjust = 0,
margin = margin(l = axis_text_margin)),
# axis tick marks
axis.ticks = NULL,
axis.ticks.x = NULL,
axis.ticks.x.top = NULL,
axis.ticks.x.bottom = NULL,
axis.ticks.y = NULL,
axis.ticks.y.left = NULL,
axis.ticks.y.right = NULL,
# length of axis tick marks
axis.ticks.length = ticks_length,
axis.ticks.length.x = NULL,
axis.ticks.length.x.top = NULL,
axis.ticks.length.x.bottom = NULL,
axis.ticks.length.y = NULL,
axis.ticks.length.y.left = NULL,
axis.ticks.length.y.right = NULL,
# axis line
axis.line = if (version == "legacy") element_blank(),
axis.line.x = NULL,
axis.line.x.top = if (version == "modern") element_blank(),
axis.line.x.bottom = if (version == "modern") element_line(),
axis.line.y = NULL,
axis.line.y.left = if (version == "modern") element_line(),
axis.line.y.right = if (version == "modern") element_blank(),
# legend
legend.background = element_rect(color = NA), # suppress border
legend.spacing = unit(base_size, "pt"), # space between legends
legend.spacing.x = NULL,
legend.spacing.y = NULL,
# legend keys
legend.key = element_rect(color = NA),
legend.key.size = NULL,
legend.key.height = unit(base_size, "pt"),
legend.key.width = unit(2 * base_size, "pt"),
# legend text
legend.text = element_text(size = rel(small)),
legend.text.align = NULL,
# legend title
# legend.title = element_blank(), # suppress legend titles
legend.title = NULL,
legend.title.align = NULL,
# legend position
legend.position = "right",
legend.direction = NULL,
legend.justification = "top",
# arrangement of muliple legends
legend.box = NULL,
legend.box.just = NULL,
legend.box.margin = margin(),
legend.box.background = element_blank(),
legend.box.spacing = unit(base_size, "pt"),
# plotting area
panel.background = panel_background,
panel.border = panel_border,
# space between panels
panel.spacing = unit(half_line, "pt"),
panel.spacing.x = NULL,
panel.spacing.y = NULL,
# grid lines
panel.grid = NULL,
panel.grid.major = NULL,
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = grid_lines,
panel.grid.minor.x = NULL,
panel.grid.minor.y = NULL,
# plot panel and grid lines over data layers?
panel.ontop = FALSE,
# background of the entire plot
plot.background = element_rect(fill = "white", color = "white"),
# plot titles
plot.title = element_text(size = rel(large), vjust = 1,
margin = margin(b = large * half_line)),
plot.subtitle = element_text(size = rel(large), vjust = 1,
margin = margin(b = large * half_line)),
plot.title.position = "plot",
# plot caption
plot.caption = element_text(face = "plain", size = rel(small), vjust = 1,
margin = margin(t = large * half_line)),
plot.caption.position = "plot",
# plot tag
plot.tag = element_text(face = "plain", size = rel(large)),
plot.tag.position = "topleft",
# plot margins
plot.margin = margin(half_line, half_line, half_line, half_line),
# facet labels (not applicable, but we should to set this anyway)
strip.background = element_rect(fill = "#E4E4E4"),
strip.background.x = NULL,
strip.background.y = NULL,
# facet label placement with respect to axis
strip.placement = "inside",
# space between facet labels and axes when facet labels are switched
strip.switch.pad.grid = unit(quarter_line, "pt"),
strip.switch.pad.wrap = unit(quarter_line, "pt"),
# indicate that this is a complete theme
complete = TRUE
)
}
#' SPSS Color Palette and Color Scales
#'
#' Color palette used by SPSS, and discrete color scales to be used in plots
#' (e.g., for multiple lines in a plot) to mimic the look of SPSS graphs.
#'
#' @param n an integer giving the number of colors to select from the palette.
#' If \code{NULL} (the default), all colors of the palette are returned.
#' @param version a character string specifying whether to use the color
#' palette of recent SPSS versions (\code{"modern"}) or older versions (<24;
#' \code{"legacy"}).
#'
#' @return \code{palette_SPSS} returns a character vector specifying up to 30
#' colors as used by SPSS.
#'
#' @author Andreas Alfons
#'
#' @examples
#' # data to be plotted
#' df <- data.frame(x = 1:30, y = 0)
#'
#' # initialize plot
#' p <- ggplot(aes(x = x, y = y, fill = factor(x)), data = df) +
#' geom_point(shape = 21, size = 3, show.legend = FALSE) +
#' theme_SPSS()
#'
#' # colors of modern SPSS versions
#' p + theme_SPSS() + scale_fill_SPSS()
#'
#' # colors of legacy SPSS versions
#' p + theme_SPSS(version = "legacy") +
#' scale_fill_SPSS(version = "legacy")
#'
#' @keywords color
#'
#' @export
palette_SPSS <- function(n = NULL, version = r2spss_options$get("version")) {
# initializations
version <- match.arg(version, choices = get_version_values())
# define color vectors
if (version == "legacy") {
colors <- c("#3E58AC", "#2EB848", "#D3CE97", "#79287D", "#FBF873",
"#EF3338", "#48C2C5", "#CCCCCC", "#7AAAD5", "#0A562C",
"#F8981D", "#DDBAF1", "#1A5F76", "#CCFFCC", "#BB3F7F",
"#999999", "#000000", "#B6E7E8", "#FFFFFF", "#797AA7",
"#70DC84", "#333333", "#ACD0EE", "#A21619", "#5D61FF",
"#E4E4E4", "#278BAC", "#B89BC9", "#666666", "#0D8D46")
} else {
colors <- c("#1192E8", "#005D5D", "#9F1853", "#FA4D56", "#570408",
"#198038", "#002D9C", "#EE538B", "#B28600", "#009D9A",
"#012749", "#8A3800", "#A56EFF", "#ECE6D0", "#454647",
"#5CCA88", "#D05334", "#CC7FE4", "#E1BC1D", "#ED4B4B",
"#1CCDCD", "#5C7148", "#E18B0E", "#092672", "#5A645E",
"#9B0000", "#CFACE3", "#969191", "#3FEB7C", "#6929C4")
}
# check number of colors to return
max <- length(colors)
if (is.numeric(n) && length(n) > 0) {
n <- n[1]
if (n < 1) {
n <- 1
warning("must request at least one color; returning the first color",
call. = FALSE)
}
if (n <= max) {
keep <- seq_len(n)
colors <- colors[keep]
} else {
warning("only ", max, " colors available; returning those colors",
call. = FALSE)
}
}
# return colors
colors
}
#' @rdname palette_SPSS
#' @export
paletteSPSS <- function(n = NULL, version = r2spss_options$get("version")) {
.Deprecated("palette_SPSS")
palette_SPSS(n, version = version)
}
#' @rdname palette_SPSS
#'
#' @param direction an integer giving the direction to travel through the
#' palette. Possible values are 1 for forward (the default) and -1 for
#' backward.
#'
#' @return \code{SPSS_pal} returns a function that generates colors from the
#' specified SPSS color palette, in the specified direction. It is mainly
#' used internally by the discrete color scales.
#'
#' @export
SPSS_pal <- function(version = r2spss_options$get("version"), direction = 1) {
# initializations
version <- match.arg(version, choices = get_version_values())
# return function to be used for discrete color scales in ggolot2
function(n) {
pal <- suppressWarnings(palette_SPSS(n, version))
if (direction == -1) pal <- rev(pal)
pal
}
}
#' @rdname palette_SPSS
#'
#' @param \dots additional arguments to be passed to
#' \code{\link[ggplot2]{discrete_scale}}.
#' @param aesthetics a character string or vector listing the names of the
#' aesthetics with which the scale works. For example, color settings can be
#' applied to the \code{color} and \code{fill} aesthetics by supplying
#' \code{c("color", "fill")}.
#'
#' @return \code{scale_color_SPSS}, \code{scale_colour_SPSS}, and
#' \code{scale_fill_SPSS} return a discrete color scale to be added to plots.
#'
#' @export
scale_color_SPSS <- function(..., version = r2spss_options$get("version"),
direction = 1, aesthetics = "color") {
discrete_scale(aesthetics, "SPSS", SPSS_pal(version, direction), ...)
}
#' @rdname palette_SPSS
#' @export
scale_colour_SPSS <- function(..., version = r2spss_options$get("version"),
direction = 1, aesthetics = "colour") {
discrete_scale(aesthetics, "SPSS", SPSS_pal(version, direction), ...)
}
#' @rdname palette_SPSS
#' @export
scale_fill_SPSS <- function(..., version = r2spss_options$get("version"),
direction = 1, aesthetics = "fill") {
discrete_scale(aesthetics, "SPSS", SPSS_pal(version, direction), ...)
}
#' Format axis tick labels similar to SPSS
#'
#' Format axis tick labels in a similar manner to SPSS to mimic the look of
#' SPSS graphs.
#'
#' \code{number_SPSS} is a wrapper for \code{\link[scales]{number}} that by
#' default does not put a separator every 3 digits so separate thousands. It
#' mainly exists to prevent scientific notation in axis tick labels, hence it
#' is typically supplied as the \code{labels} argument of
#' \code{\link[ggplot2]{scale_x_continuous}} or
#' \code{\link[ggplot2]{scale_y_continuous}}.
#'
#' \code{substr_SPSS} is a wrapper for \code{\link{substr}} to cut character
#' strings by default to the first 8 characters, which is SPSS behavior for
#' the tick labels of a discrete axis in some (but not all) plots. It is
#' typically supplied as the \code{labels} argument of
#' \code{\link[ggplot2]{scale_x_discrete}} or
#' \code{\link[ggplot2]{scale_y_discrete}}.
#'
#' @name labels_SPSS
#'
#' @param x for \code{number_SPSS}, a numeric vector to format. For
#' \code{substr_SPSS}, a vector of character strings to be cut.
#' @param big.mark a character string to be inserted every 3 digits to
#' separate thousands. The default is an empty string for no separation.
#' @param \dots additional arguments to be passed to
#' \code{\link[scales]{number}}.
#' @param start,stop integers giving the first and last character to remain in
#' the cut string, respectively. The default is to cut strings to the first 8
#' characters.
#'
#' @return A character vector of the same length as \code{x}
#'
#' @keywords utilities
NULL
#' @rdname labels_SPSS
#' @importFrom scales number
#' @export
number_SPSS <- function(x, big.mark = "", ...) {
scales::number(x, big.mark = big.mark, ...)
}
#' @rdname labels_SPSS
#' @export
numberSPSS <- function(x, big.mark = "", ...) {
.Deprecated("number_SPSS")
number_SPSS(x, big.mark = big.mark, ...)
}
#' @rdname labels_SPSS
#' @export
substr_SPSS <- function(x, start = 1, stop = 8) {
substr(x, start = start, stop = stop)
}
#' @rdname labels_SPSS
#' @export
substrSPSS <- function(x, start = 1, stop = 8) {
.Deprecated("substr_SPSS")
substr_SPSS(x, start = start, stop = stop)
}
# internal function similar to standardise_aes_names() but directly returning
# list of arguments with standardized names
standardize_args <- function(args, replace = NULL) {
# obtain argument names
argument_names <- names(args)
# default mapping of names (frequently used graphical parameters)
if (is.null(replace)) replace <- get_aes_mapping()
# replace names if necessary
replace <- replace[names(replace) %in% argument_names]
if (length(replace) > 0) {
argument_names[match(names(replace), argument_names)] <- replace
names(args) <- argument_names
}
# return list of arguments with standardized names
args
}
# internal function to obtain mapping of graphical parameters to aesthetics
get_aes_mapping <- function() {
c(col = "color", colour = "color", bg = "fill", fg = "color",
pch = "shape", cex = "size", lty = "linetype", lwd = "size",
srt = "angle", adj = "hjust", min = "ymin", max = "ymax")
}
# internal function to obtain mapping of aesthetics to graphical parameters
get_par_mapping <- function(which = "point") {
c(color = "col", colour = "col", fill = "bg",
shape = "pch", size = "cex", title = "main")
}
aalfons/r2spss documentation built on June 15, 2022, 4:51 a.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 get_par_mapping get_aes_mapping standardize_args substrSPSS substr_SPSS numberSPSS number_SPSS scale_fill_SPSS scale_colour_SPSS scale_color_SPSS SPSS_pal paletteSPSS palette_SPSS theme_SPSS
Documented in numberSPSS number_SPSS paletteSPSS palette_SPSS scale_color_SPSS scale_colour_SPSS scale_fill_SPSS SPSS_pal substrSPSS substr_SPSS theme_SPSS
# --------------------------------------
# Author: Andreas Alfons
# Erasmus Universiteit Rotterdam
# --------------------------------------
#' Plot theme to mimic the look of SPSS graphs
#'
#' Complete theme that controls all non-data display of a plot to mimic the
#' look of SPSS graphs. Use \code{\link[ggplot2]{theme}} after
#' \code{theme_SPSS} to further tweak the display.
#'
#' @param base_size an integer giving the base font size in pts.
#' @param base_family a character string giving the base font family.
#' @param base_line_size base size for line elements.
#' @param base_rect_size base size for borders of rectangle elements.
#' @param version a character string specifying whether to mimic the look
#' of recent SPSS versions (\code{"modern"}) or older versions (<24;
#' \code{"legacy"}).
#' @param scales,scale.x,scale.y a character string specifying whether both
#' or each of the axes are expected to be continuous (\code{"continuous"}) or
#' discrete (\code{"discrete"}). Note that this only controls the appearance
#' of the tick labels on the axis, as the theme has no control over the
#' information that is displayed in the plot. SPSS displays larger tick
#' labels a for discrete axis than for a continuous axis, hence specifying
#' this information in the theme adjusts the tick label size accordingly.
#' The default (\code{NULL}) means that the tick labels are of the same size
#' as for a continuous axis.
#'
#' @examples
#' # data to be plotted
#' df <- data.frame(x = 1:30, y = 0)
#'
#' # initialize plot
#' p <- ggplot(aes(x = x, y = y, fill = factor(x)), data = df) +
#' geom_point(shape = 21, size = 3, show.legend = FALSE) +
#' theme_SPSS()
#'
#' # colors of modern SPSS versions
#' p + theme_SPSS() + scale_fill_SPSS()
#'
#' # colors of legacy SPSS versions
#' p + theme_SPSS(version = "legacy") +
#' scale_fill_SPSS(version = "legacy")
#'
#' @keywords aplot
#'
#' @import ggplot2
#' @export
theme_SPSS <- function(base_size = 12, base_family = "",
base_line_size = 0.5,
base_rect_size = 0.5,
version = r2spss_options$get("version"),
scales = NULL, scale.x = scales, scale.y = scales) {
# initializations
version <- match.arg(version, choices = get_version_values())
scales <- match.arg(scales, choices = get_scale_values())
scale.x <- match.arg(scale.x, choices = get_scale_values())
scale.y <- match.arg(scale.y, choices = get_scale_values())
# useful measurements
half_line <- base_size / 2
quarter_line <- half_line / 2
tiny <- 0.8 # multiplication factor to make some elements tiny
small <- 0.9 # multiplication factor to make some elements smaller
large <- 1.2 # multiplication factor to make some elements larger
# define some elements to be used in the theme
if (version == "legacy") {
ticks_length <- unit(half_line, "pt")
axis_text_margin <- tiny * quarter_line
panel_background <- element_rect(fill = "#F0F0F0", color = NA)
panel_border <- element_rect(fill = NA, color = "black")
grid_lines <- element_blank()
} else {
ticks_length <- unit(0, "pt")
axis_text_margin <- quarter_line
panel_background <- element_rect(fill = "white", color = NA)
panel_border <- element_blank()
grid_lines <- element_line(color = "#AEAEAE")
}
# define theme
theme(
# basic elements
line = element_line(color = "black", size = base_line_size,
linetype = "solid", lineend = "butt"),
rect = element_rect(fill = "white", color = "black",
size = base_rect_size, linetype = "solid"),
text = element_text(family = base_family, face = "plain", color = "black",
size = base_size, hjust = 0.5, vjust = 0.5, angle = 0,
lineheight = 0.9, margin = margin(), debug = FALSE),
title = element_text(face = "bold"),
aspect.ratio = NULL,
# axis labels
# axis.title = element_text(face = "bold"),
axis.title = NULL,
axis.title.x = element_text(vjust = 1,
margin = margin(t = half_line)),
axis.title.y = element_text(vjust = 1,
angle = 90,
margin = margin(r = half_line)),
axis.title.x.top = element_text(vjust = 0,
margin = margin(b = half_line)),
axis.title.x.bottom = NULL,
axis.title.y.left = NULL,
axis.title.y.right = element_text(vjust = 0,
angle = -90,
margin = margin(l = half_line)),
# axis tick labels
axis.text = element_text(color = "black",
size = if (scales != "discrete") rel(tiny)),
axis.text.x = element_text(size = if (scale.x == "discrete") base_size,
vjust = 1,
margin = margin(t = axis_text_margin)),
axis.text.y = element_text(size = if (scale.y == "discrete") base_size,
hjust = 1,
margin = margin(r = axis_text_margin)),
axis.text.x.top = element_text(vjust = 0,
margin = margin(b = axis_text_margin)),
axis.text.x.bottom = NULL,
axis.text.y.left = NULL,
axis.text.y.right = element_text(hjust = 0,
margin = margin(l = axis_text_margin)),
# axis tick marks
axis.ticks = NULL,
axis.ticks.x = NULL,
axis.ticks.x.top = NULL,
axis.ticks.x.bottom = NULL,
axis.ticks.y = NULL,
axis.ticks.y.left = NULL,
axis.ticks.y.right = NULL,
# length of axis tick marks
axis.ticks.length = ticks_length,
axis.ticks.length.x = NULL,
axis.ticks.length.x.top = NULL,
axis.ticks.length.x.bottom = NULL,
axis.ticks.length.y = NULL,
axis.ticks.length.y.left = NULL,
axis.ticks.length.y.right = NULL,
# axis line
axis.line = if (version == "legacy") element_blank(),
axis.line.x = NULL,
axis.line.x.top = if (version == "modern") element_blank(),
axis.line.x.bottom = if (version == "modern") element_line(),
axis.line.y = NULL,
axis.line.y.left = if (version == "modern") element_line(),
axis.line.y.right = if (version == "modern") element_blank(),
# legend
legend.background = element_rect(color = NA), # suppress border
legend.spacing = unit(base_size, "pt"), # space between legends
legend.spacing.x = NULL,
legend.spacing.y = NULL,
# legend keys
legend.key = element_rect(color = NA),
legend.key.size = NULL,
legend.key.height = unit(base_size, "pt"),
legend.key.width = unit(2 * base_size, "pt"),
# legend text
legend.text = element_text(size = rel(small)),
legend.text.align = NULL,
# legend title
# legend.title = element_blank(), # suppress legend titles
legend.title = NULL,
legend.title.align = NULL,
# legend position
legend.position = "right",
legend.direction = NULL,
legend.justification = "top",
# arrangement of muliple legends
legend.box = NULL,
legend.box.just = NULL,
legend.box.margin = margin(),
legend.box.background = element_blank(),
legend.box.spacing = unit(base_size, "pt"),
# plotting area
panel.background = panel_background,
panel.border = panel_border,
# space between panels
panel.spacing = unit(half_line, "pt"),
panel.spacing.x = NULL,
panel.spacing.y = NULL,
# grid lines
panel.grid = NULL,
panel.grid.major = NULL,
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = grid_lines,
panel.grid.minor.x = NULL,
panel.grid.minor.y = NULL,
# plot panel and grid lines over data layers?
panel.ontop = FALSE,
# background of the entire plot
plot.background = element_rect(fill = "white", color = "white"),
# plot titles
plot.title = element_text(size = rel(large), vjust = 1,
margin = margin(b = large * half_line)),
plot.subtitle = element_text(size = rel(large), vjust = 1,
margin = margin(b = large * half_line)),
plot.title.position = "plot",
# plot caption
plot.caption = element_text(face = "plain", size = rel(small), vjust = 1,
margin = margin(t = large * half_line)),
plot.caption.position = "plot",
# plot tag
plot.tag = element_text(face = "plain", size = rel(large)),
plot.tag.position = "topleft",
# plot margins
plot.margin = margin(half_line, half_line, half_line, half_line),
# facet labels (not applicable, but we should to set this anyway)
strip.background = element_rect(fill = "#E4E4E4"),
strip.background.x = NULL,
strip.background.y = NULL,
# facet label placement with respect to axis
strip.placement = "inside",
# space between facet labels and axes when facet labels are switched
strip.switch.pad.grid = unit(quarter_line, "pt"),
strip.switch.pad.wrap = unit(quarter_line, "pt"),
# indicate that this is a complete theme
complete = TRUE
)
}
#' SPSS Color Palette and Color Scales
#'
#' Color palette used by SPSS, and discrete color scales to be used in plots
#' (e.g., for multiple lines in a plot) to mimic the look of SPSS graphs.
#'
#' @param n an integer giving the number of colors to select from the palette.
#' If \code{NULL} (the default), all colors of the palette are returned.
#' @param version a character string specifying whether to use the color
#' palette of recent SPSS versions (\code{"modern"}) or older versions (<24;
#' \code{"legacy"}).
#'
#' @return \code{palette_SPSS} returns a character vector specifying up to 30
#' colors as used by SPSS.
#'
#' @author Andreas Alfons
#'
#' @examples
#' # data to be plotted
#' df <- data.frame(x = 1:30, y = 0)
#'
#' # initialize plot
#' p <- ggplot(aes(x = x, y = y, fill = factor(x)), data = df) +
#' geom_point(shape = 21, size = 3, show.legend = FALSE) +
#' theme_SPSS()
#'
#' # colors of modern SPSS versions
#' p + theme_SPSS() + scale_fill_SPSS()
#'
#' # colors of legacy SPSS versions
#' p + theme_SPSS(version = "legacy") +
#' scale_fill_SPSS(version = "legacy")
#'
#' @keywords color
#'
#' @export
palette_SPSS <- function(n = NULL, version = r2spss_options$get("version")) {
# initializations
version <- match.arg(version, choices = get_version_values())
# define color vectors
if (version == "legacy") {
colors <- c("#3E58AC", "#2EB848", "#D3CE97", "#79287D", "#FBF873",
"#EF3338", "#48C2C5", "#CCCCCC", "#7AAAD5", "#0A562C",
"#F8981D", "#DDBAF1", "#1A5F76", "#CCFFCC", "#BB3F7F",
"#999999", "#000000", "#B6E7E8", "#FFFFFF", "#797AA7",
"#70DC84", "#333333", "#ACD0EE", "#A21619", "#5D61FF",
"#E4E4E4", "#278BAC", "#B89BC9", "#666666", "#0D8D46")
} else {
colors <- c("#1192E8", "#005D5D", "#9F1853", "#FA4D56", "#570408",
"#198038", "#002D9C", "#EE538B", "#B28600", "#009D9A",
"#012749", "#8A3800", "#A56EFF", "#ECE6D0", "#454647",
"#5CCA88", "#D05334", "#CC7FE4", "#E1BC1D", "#ED4B4B",
"#1CCDCD", "#5C7148", "#E18B0E", "#092672", "#5A645E",
"#9B0000", "#CFACE3", "#969191", "#3FEB7C", "#6929C4")
}
# check number of colors to return
max <- length(colors)
if (is.numeric(n) && length(n) > 0) {
n <- n[1]
if (n < 1) {
n <- 1
warning("must request at least one color; returning the first color",
call. = FALSE)
}
if (n <= max) {
keep <- seq_len(n)
colors <- colors[keep]
} else {
warning("only ", max, " colors available; returning those colors",
call. = FALSE)
}
}
# return colors
colors
}
#' @rdname palette_SPSS
#' @export
paletteSPSS <- function(n = NULL, version = r2spss_options$get("version")) {
.Deprecated("palette_SPSS")
palette_SPSS(n, version = version)
}
#' @rdname palette_SPSS
#'
#' @param direction an integer giving the direction to travel through the
#' palette. Possible values are 1 for forward (the default) and -1 for
#' backward.
#'
#' @return \code{SPSS_pal} returns a function that generates colors from the
#' specified SPSS color palette, in the specified direction. It is mainly
#' used internally by the discrete color scales.
#'
#' @export
SPSS_pal <- function(version = r2spss_options$get("version"), direction = 1) {
# initializations
version <- match.arg(version, choices = get_version_values())
# return function to be used for discrete color scales in ggolot2
function(n) {
pal <- suppressWarnings(palette_SPSS(n, version))
if (direction == -1) pal <- rev(pal)
pal
}
}
#' @rdname palette_SPSS
#'
#' @param \dots additional arguments to be passed to
#' \code{\link[ggplot2]{discrete_scale}}.
#' @param aesthetics a character string or vector listing the names of the
#' aesthetics with which the scale works. For example, color settings can be
#' applied to the \code{color} and \code{fill} aesthetics by supplying
#' \code{c("color", "fill")}.
#'
#' @return \code{scale_color_SPSS}, \code{scale_colour_SPSS}, and
#' \code{scale_fill_SPSS} return a discrete color scale to be added to plots.
#'
#' @export
scale_color_SPSS <- function(..., version = r2spss_options$get("version"),
direction = 1, aesthetics = "color") {
discrete_scale(aesthetics, "SPSS", SPSS_pal(version, direction), ...)
}
#' @rdname palette_SPSS
#' @export
scale_colour_SPSS <- function(..., version = r2spss_options$get("version"),
direction = 1, aesthetics = "colour") {
discrete_scale(aesthetics, "SPSS", SPSS_pal(version, direction), ...)
}
#' @rdname palette_SPSS
#' @export
scale_fill_SPSS <- function(..., version = r2spss_options$get("version"),
direction = 1, aesthetics = "fill") {
discrete_scale(aesthetics, "SPSS", SPSS_pal(version, direction), ...)
}
#' Format axis tick labels similar to SPSS
#'
#' Format axis tick labels in a similar manner to SPSS to mimic the look of
#' SPSS graphs.
#'
#' \code{number_SPSS} is a wrapper for \code{\link[scales]{number}} that by
#' default does not put a separator every 3 digits so separate thousands. It
#' mainly exists to prevent scientific notation in axis tick labels, hence it
#' is typically supplied as the \code{labels} argument of
#' \code{\link[ggplot2]{scale_x_continuous}} or
#' \code{\link[ggplot2]{scale_y_continuous}}.
#'
#' \code{substr_SPSS} is a wrapper for \code{\link{substr}} to cut character
#' strings by default to the first 8 characters, which is SPSS behavior for
#' the tick labels of a discrete axis in some (but not all) plots. It is
#' typically supplied as the \code{labels} argument of
#' \code{\link[ggplot2]{scale_x_discrete}} or
#' \code{\link[ggplot2]{scale_y_discrete}}.
#'
#' @name labels_SPSS
#'
#' @param x for \code{number_SPSS}, a numeric vector to format. For
#' \code{substr_SPSS}, a vector of character strings to be cut.
#' @param big.mark a character string to be inserted every 3 digits to
#' separate thousands. The default is an empty string for no separation.
#' @param \dots additional arguments to be passed to
#' \code{\link[scales]{number}}.
#' @param start,stop integers giving the first and last character to remain in
#' the cut string, respectively. The default is to cut strings to the first 8
#' characters.
#'
#' @return A character vector of the same length as \code{x}
#'
#' @keywords utilities
NULL
#' @rdname labels_SPSS
#' @importFrom scales number
#' @export
number_SPSS <- function(x, big.mark = "", ...) {
scales::number(x, big.mark = big.mark, ...)
}
#' @rdname labels_SPSS
#' @export
numberSPSS <- function(x, big.mark = "", ...) {
.Deprecated("number_SPSS")
number_SPSS(x, big.mark = big.mark, ...)
}
#' @rdname labels_SPSS
#' @export
substr_SPSS <- function(x, start = 1, stop = 8) {
substr(x, start = start, stop = stop)
}
#' @rdname labels_SPSS
#' @export
substrSPSS <- function(x, start = 1, stop = 8) {
.Deprecated("substr_SPSS")
substr_SPSS(x, start = start, stop = stop)
}
# internal function similar to standardise_aes_names() but directly returning
# list of arguments with standardized names
standardize_args <- function(args, replace = NULL) {
# obtain argument names
argument_names <- names(args)
# default mapping of names (frequently used graphical parameters)
if (is.null(replace)) replace <- get_aes_mapping()
# replace names if necessary
replace <- replace[names(replace) %in% argument_names]
if (length(replace) > 0) {
argument_names[match(names(replace), argument_names)] <- replace
names(args) <- argument_names
}
# return list of arguments with standardized names
args
}
# internal function to obtain mapping of graphical parameters to aesthetics
get_aes_mapping <- function() {
c(col = "color", colour = "color", bg = "fill", fg = "color",
pch = "shape", cex = "size", lty = "linetype", lwd = "size",
srt = "angle", adj = "hjust", min = "ymin", max = "ymax")
}
# internal function to obtain mapping of aesthetics to graphical parameters
get_par_mapping <- function(which = "point") {
c(color = "col", colour = "col", fill = "bg",
shape = "pch", size = "cex", title = "main")
}
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.