Bob Rudis
8 years ago
19 changed files with 375 additions and 88 deletions
@ -0,0 +1,133 @@ |
|||||
|
state_trans <- c(AL='B', AK='A', AZ='D', AR='C', CA='E', CO='F', CT='G', |
||||
|
DE='H', DC='y', FL='I', GA='J', HI='K', ID='M', IL='N', |
||||
|
IN='O', IA='L', KS='P', KY='Q', LA='R', ME='U', MD='T', |
||||
|
MA='S', MI='V', MN='W', MS='Y', MO='X', MT='Z', NE='c', |
||||
|
NV='g', NH='d', NJ='e', NM='f', NY='h', NC='a', ND='b', |
||||
|
OH='i', OK='j', OR='k', PA='l', RI='m', SC='n', SD='o', |
||||
|
TN='p', TX='q', UT='r', VT='t', VA='s', WA='u', WV='w', |
||||
|
WI='v', WY='x', US='z') |
||||
|
|
||||
|
state_tbl <- setNames(toupper(state.abb), tolower(state.name)) |
||||
|
|
||||
|
#' Show location of StateFace font |
||||
|
#' |
||||
|
#' Displays the path to the StateFace font. For the font to work |
||||
|
#' in the on-screen plot device for ggplot2, you need to install |
||||
|
#' the font on your system |
||||
|
#' @export |
||||
|
show_stateface <- function() { |
||||
|
system.file("fonts/", package="ggalt") |
||||
|
} |
||||
|
|
||||
|
#' Load stateface font |
||||
|
#' |
||||
|
#' @export |
||||
|
load_stateface <- function() { |
||||
|
if (!any(grepl("StateFace", extrafont::fonts()))) { |
||||
|
tmp <- capture.output(suppressWarnings(extrafont::ttf_import( |
||||
|
system.file("fonts/", package="ggalt"), |
||||
|
prompt=FALSE, pattern="*.ttf", recursive=FALSE))) |
||||
|
} |
||||
|
tmp <- capture.output(suppressWarnings(extrafont::loadfonts(quiet=TRUE))) |
||||
|
} |
||||
|
|
||||
|
#' Use ProPublica's StateFace font in ggplot2 plots |
||||
|
#' |
||||
|
#' @inheritParams ggplot2::geom_text |
||||
|
#' @export |
||||
|
geom_stateface <- function(mapping = NULL, data = NULL, stat = "identity", |
||||
|
position = "identity", ..., parse = FALSE, |
||||
|
nudge_x = 0, nudge_y = 0, check_overlap = FALSE, |
||||
|
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { |
||||
|
|
||||
|
if (!missing(nudge_x) || !missing(nudge_y)) { |
||||
|
if (!missing(position)) { |
||||
|
stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) |
||||
|
} |
||||
|
|
||||
|
position <- position_nudge(nudge_x, nudge_y) |
||||
|
} |
||||
|
|
||||
|
layer( |
||||
|
data = data, |
||||
|
mapping = mapping, |
||||
|
stat = stat, |
||||
|
geom = GeomStateface, |
||||
|
position = position, |
||||
|
show.legend = show.legend, |
||||
|
inherit.aes = inherit.aes, |
||||
|
params = list( |
||||
|
parse = parse, |
||||
|
check_overlap = check_overlap, |
||||
|
na.rm = na.rm, |
||||
|
... |
||||
|
) |
||||
|
) |
||||
|
|
||||
|
} |
||||
|
|
||||
|
#' @rdname ggalt-ggproto |
||||
|
#' @format NULL |
||||
|
#' @usage NULL |
||||
|
#' @export |
||||
|
GeomStateface <- ggproto("GeomStateface", Geom, |
||||
|
required_aes = c("x", "y", "label"), |
||||
|
|
||||
|
default_aes = aes( |
||||
|
colour = "black", size = 3.88, angle = 0, hjust = 0.5, |
||||
|
vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2 |
||||
|
), |
||||
|
|
||||
|
draw_panel = function(data, panel_scales, coord, parse = FALSE, |
||||
|
na.rm = FALSE, check_overlap = FALSE) { |
||||
|
lab <- data$label |
||||
|
|
||||
|
if (max(sapply(lab, nchar)) == 2) { |
||||
|
lab <- unname(state_trans[toupper(lab)]) |
||||
|
} else { |
||||
|
lab <- unname(state_trans[state_tbl[tolower(lab)]]) |
||||
|
} |
||||
|
|
||||
|
data <- coord$transform(data, panel_scales) |
||||
|
if (is.character(data$vjust)) { |
||||
|
data$vjust <- compute_just(data$vjust, data$y) |
||||
|
} |
||||
|
if (is.character(data$hjust)) { |
||||
|
data$hjust <- compute_just(data$hjust, data$x) |
||||
|
} |
||||
|
|
||||
|
textGrob( |
||||
|
lab, |
||||
|
data$x, data$y, default.units = "native", |
||||
|
hjust = data$hjust, vjust = data$vjust, |
||||
|
rot = data$angle, |
||||
|
gp = gpar( |
||||
|
col = alpha(data$colour, data$alpha), |
||||
|
fontsize = data$size * .pt, |
||||
|
fontfamily = "StateFace", |
||||
|
fontface = data$fontface, |
||||
|
lineheight = data$lineheight |
||||
|
), |
||||
|
check.overlap = check_overlap |
||||
|
) |
||||
|
}, |
||||
|
|
||||
|
draw_key = draw_key_text |
||||
|
) |
||||
|
|
||||
|
compute_just <- function(just, x) { |
||||
|
inward <- just == "inward" |
||||
|
just[inward] <- c("left", "middle", "right")[just_dir(x[inward])] |
||||
|
outward <- just == "outward" |
||||
|
just[outward] <- c("right", "middle", "left")[just_dir(x[outward])] |
||||
|
|
||||
|
unname(c(left = 0, center = 0.5, right = 1, |
||||
|
bottom = 0, middle = 0.5, top = 1)[just]) |
||||
|
} |
||||
|
|
||||
|
just_dir <- function(x, tol = 0.001) { |
||||
|
out <- rep(2L, length(x)) |
||||
|
out[x < 0.5 - tol] <- 1L |
||||
|
out[x > 0.5 + tol] <- 3L |
||||
|
out |
||||
|
} |
@ -0,0 +1,11 @@ |
|||||
|
.onAttach <- function(...) { |
||||
|
|
||||
|
if (!interactive()) return() |
||||
|
|
||||
|
load_stateface() |
||||
|
|
||||
|
packageStartupMessage(paste0("ggalt is under *active* development. ", |
||||
|
"See https://github.com/hrbrmstr/ggalt for changes")) |
||||
|
|
||||
|
} |
||||
|
|
Binary file not shown.
@ -0,0 +1,67 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/stateface.r |
||||
|
\name{geom_stateface} |
||||
|
\alias{geom_stateface} |
||||
|
\title{Use ProPublica's StateFace font in ggplot2 plots} |
||||
|
\usage{ |
||||
|
geom_stateface(mapping = NULL, data = NULL, stat = "identity", |
||||
|
position = "identity", ..., parse = FALSE, nudge_x = 0, nudge_y = 0, |
||||
|
check_overlap = FALSE, na.rm = FALSE, show.legend = NA, |
||||
|
inherit.aes = TRUE) |
||||
|
} |
||||
|
\arguments{ |
||||
|
\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or |
||||
|
\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the |
||||
|
default), it is combined with the default mapping at the top level of the |
||||
|
plot. You must supply \code{mapping} if there is no plot mapping.} |
||||
|
|
||||
|
\item{data}{The data to be displayed in this layer. There are three |
||||
|
options: |
||||
|
|
||||
|
If \code{NULL}, the default, the data is inherited from the plot |
||||
|
data as specified in the call to \code{\link{ggplot}}. |
||||
|
|
||||
|
A \code{data.frame}, or other object, will override the plot |
||||
|
data. All objects will be fortified to produce a data frame. See |
||||
|
\code{\link{fortify}} for which variables will be created. |
||||
|
|
||||
|
A \code{function} will be called with a single argument, |
||||
|
the plot data. The return value must be a \code{data.frame.}, and |
||||
|
will be used as the layer data.} |
||||
|
|
||||
|
\item{stat}{The statistical transformation to use on the data for this |
||||
|
layer, as a string.} |
||||
|
|
||||
|
\item{position}{Position adjustment, either as a string, or the result of |
||||
|
a call to a position adjustment function.} |
||||
|
|
||||
|
\item{...}{other arguments passed on to \code{\link{layer}}. These are |
||||
|
often aesthetics, used to set an aesthetic to a fixed value, like |
||||
|
\code{color = "red"} or \code{size = 3}. They may also be parameters |
||||
|
to the paired geom/stat.} |
||||
|
|
||||
|
\item{parse}{If TRUE, the labels will be parsed into expressions and |
||||
|
displayed as described in ?plotmath} |
||||
|
|
||||
|
\item{nudge_x}{Horizontal and vertical adjustment to nudge labels by. |
||||
|
Useful for offsetting text from points, particularly on discrete scales.} |
||||
|
|
||||
|
\item{check_overlap}{If \code{TRUE}, text that overlaps previous text in the |
||||
|
same layer will not be plotted. A quick and dirty way} |
||||
|
|
||||
|
\item{na.rm}{If \code{FALSE} (the default), removes missing values with |
||||
|
a warning. If \code{TRUE} silently removes missing values.} |
||||
|
|
||||
|
\item{show.legend}{logical. Should this layer be included in the legends? |
||||
|
\code{NA}, the default, includes if any aesthetics are mapped. |
||||
|
\code{FALSE} never includes, and \code{TRUE} always includes.} |
||||
|
|
||||
|
\item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, |
||||
|
rather than combining with them. This is most useful for helper functions |
||||
|
that define both data and aesthetics and shouldn't inherit behaviour from |
||||
|
the default plot specification, e.g. \code{\link{borders}}.} |
||||
|
} |
||||
|
\description{ |
||||
|
Use ProPublica's StateFace font in ggplot2 plots |
||||
|
} |
||||
|
|
@ -0,0 +1,12 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/stateface.r |
||||
|
\name{load_stateface} |
||||
|
\alias{load_stateface} |
||||
|
\title{Load stateface font} |
||||
|
\usage{ |
||||
|
load_stateface() |
||||
|
} |
||||
|
\description{ |
||||
|
Load stateface font |
||||
|
} |
||||
|
|
@ -0,0 +1,14 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/stateface.r |
||||
|
\name{show_stateface} |
||||
|
\alias{show_stateface} |
||||
|
\title{Show location of StateFace font} |
||||
|
\usage{ |
||||
|
show_stateface() |
||||
|
} |
||||
|
\description{ |
||||
|
Displays the path to the StateFace font. For the font to work |
||||
|
in the on-screen plot device for ggplot2, you need to install |
||||
|
the font on your system |
||||
|
} |
||||
|
|
Loading…
Reference in new issue