Jonathan Sidi
7 years ago
7 changed files with 512 additions and 6 deletions
@ -0,0 +1,377 @@ |
|||||
|
#' Annotation: tick marks |
||||
|
#' |
||||
|
#' This annotation adds tick marks to an axis |
||||
|
#' |
||||
|
#' @export |
||||
|
#' @inheritParams ggplot2::annotation_logticks |
||||
|
#' @param scale character, vector of type of scale attributed to each corresponding side, Default: 'identity' |
||||
|
#' @param ticks_per_base integer, number of minor ticks between each pair of major ticks, Default: NULL |
||||
|
#' @details |
||||
|
#' If scale is of length one it will be replicated to the number of sides given, but if the |
||||
|
#' length of scale is larger than one it must match the number of sides given. |
||||
|
#' If ticks_per_base is set to NULL the function infers the number of ticks per base to be |
||||
|
#' the base of the scale - 1, for example log scale is base exp(1) and |
||||
|
#' log10 and identity are base 10. If ticks_per_base is given it follows the same logic as scale. |
||||
|
#' @examples |
||||
|
#' |
||||
|
#' p <- ggplot(msleep, aes(bodywt, brainwt)) + geom_point() |
||||
|
#' |
||||
|
#' # Default behavior |
||||
|
#' |
||||
|
#' # add identity scale minor ticks on y axis |
||||
|
#' p + annotation_ticks(sides = 'l') |
||||
|
#' |
||||
|
#' # add identity scale minor ticks on x,y axis |
||||
|
#' p + annotation_ticks(sides = 'lb') |
||||
|
#' |
||||
|
#' # Control number of minor ticks of each side independently |
||||
|
#' |
||||
|
#' # add identity scale minor ticks on x,y axis |
||||
|
#' p + annotation_ticks(sides = 'lb', ticks_per_base = c(10,5)) |
||||
|
#' |
||||
|
#' # log10 scale |
||||
|
#' p1 <- p + scale_x_log10() |
||||
|
#' |
||||
|
#' # add minor ticks on log10 scale |
||||
|
#' p1 + annotation_ticks(sides = 'b', scale = 'log10') |
||||
|
#' |
||||
|
#' # add minor ticks on both scales |
||||
|
#' p1 + annotation_ticks(sides = 'lb', scale = c('identity','log10')) |
||||
|
#' |
||||
|
#' # add minor ticks on both scales, but force x axis to be identity |
||||
|
#' p1 + annotation_ticks(sides = 'lb', scale = 'identity') |
||||
|
#' |
||||
|
#' # log scale |
||||
|
#' p2 <- p + scale_x_continuous(trans = 'log') |
||||
|
#' |
||||
|
#' # add minor ticks on log scale |
||||
|
#' p2 + annotation_ticks(sides = 'b', scale = 'log') |
||||
|
#' |
||||
|
#' # add minor ticks on both scales |
||||
|
#' p2 + annotation_ticks(sides = 'lb', scale = c('identity','log')) |
||||
|
#' |
||||
|
#' # add minor ticks on both scales, but force x axis to be identity |
||||
|
#' p2 + annotation_ticks(sides = 'lb', scale = 'identity') |
||||
|
#' |
||||
|
#' @import grid |
||||
|
#' @import ggplot2 |
||||
|
#' @author Jonathan Sidi |
||||
|
#' @rdname annotation_ticks |
||||
|
annotation_ticks <- function(sides = "b", |
||||
|
scale = "identity", |
||||
|
scaled = TRUE, |
||||
|
short = unit(0.1, "cm"), |
||||
|
mid = unit(0.2, "cm"), |
||||
|
long = unit(0.3, "cm"), |
||||
|
colour = "black", |
||||
|
size = 0.5, |
||||
|
linetype = 1, |
||||
|
alpha = 1, |
||||
|
color = NULL, |
||||
|
ticks_per_base = NULL, |
||||
|
...) { |
||||
|
if (!is.null(color)) { |
||||
|
colour <- color |
||||
|
} |
||||
|
|
||||
|
# check for invalid side |
||||
|
if (grepl("[^btlr]", sides)) { |
||||
|
stop(gsub("[btlr]", "", sides), " is not a valid side: b,t,l,r are valid") |
||||
|
} |
||||
|
|
||||
|
# split sides to character vector |
||||
|
sides <- strsplit(sides, "")[[1]] |
||||
|
|
||||
|
if (length(sides) != length(scale)) { |
||||
|
if (length(scale) == 1) { |
||||
|
scale <- rep(scale, length(sides)) |
||||
|
} else { |
||||
|
stop("Number of scales does not match the number of sides") |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
base <- sapply(scale, function(x) switch(x, "identity" = 10, "log10" = 10, "log" = exp(1)), USE.NAMES = FALSE) |
||||
|
|
||||
|
if (missing(ticks_per_base)) { |
||||
|
ticks_per_base <- base - 1 |
||||
|
} else { |
||||
|
if ((length(sides) != length(ticks_per_base))) { |
||||
|
if (length(ticks_per_base) == 1) { |
||||
|
ticks_per_base <- rep(ticks_per_base, length(sides)) |
||||
|
} else { |
||||
|
stop("Number of ticks_per_base does not match the number of sides") |
||||
|
} |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
delog <- scale %in% "identity" |
||||
|
|
||||
|
layer( |
||||
|
data = data.frame(x = NA), |
||||
|
mapping = NULL, |
||||
|
stat = StatIdentity, |
||||
|
geom = GeomTicks, |
||||
|
position = PositionIdentity, |
||||
|
show.legend = FALSE, |
||||
|
inherit.aes = FALSE, |
||||
|
params = list( |
||||
|
base = base, |
||||
|
sides = sides, |
||||
|
scaled = scaled, |
||||
|
short = short, |
||||
|
mid = mid, |
||||
|
long = long, |
||||
|
colour = colour, |
||||
|
size = size, |
||||
|
linetype = linetype, |
||||
|
alpha = alpha, |
||||
|
ticks_per_base = ticks_per_base, |
||||
|
delog = delog, |
||||
|
... |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
|
||||
|
#' Base ggproto classes for ggplot2 |
||||
|
#' |
||||
|
#' If you are creating a new geom, stat, position, or scale in another package, |
||||
|
#' you'll need to extend from ggplot2::Geom, ggplot2::Stat, ggplot2::Position, or ggplot2::Scale. |
||||
|
#' |
||||
|
#' @seealso \code{\link[ggplot2]{ggplot2-ggproto}} |
||||
|
#' @usage NULL |
||||
|
#' @format NULL |
||||
|
#' @rdname ggplot2-ggproto |
||||
|
#' @export |
||||
|
GeomTicks <- ggproto( |
||||
|
"GeomTicks", Geom, |
||||
|
extra_params = "", |
||||
|
handle_na = function(data, params) { |
||||
|
data |
||||
|
}, |
||||
|
|
||||
|
draw_panel = function(data, |
||||
|
panel_scales, |
||||
|
coord, |
||||
|
base = c(10, 10), |
||||
|
sides = c("b", "l"), |
||||
|
scaled = TRUE, |
||||
|
short = unit(0.1, "cm"), |
||||
|
mid = unit(0.2, "cm"), |
||||
|
long = unit(0.3, "cm"), |
||||
|
ticks_per_base = base - 1, |
||||
|
delog = c(x = TRUE, y = TRUE)) { |
||||
|
ticks <- list() |
||||
|
|
||||
|
# Convert these units to numbers so that they can be put in data frames |
||||
|
short <- convertUnit(short, "cm", valueOnly = TRUE) |
||||
|
mid <- convertUnit(mid, "cm", valueOnly = TRUE) |
||||
|
long <- convertUnit(long, "cm", valueOnly = TRUE) |
||||
|
|
||||
|
for (s in 1:length(sides)) { |
||||
|
if (grepl("[b|t]", sides[s])) { |
||||
|
|
||||
|
# Get positions of x tick marks |
||||
|
xticks <- calc_ticks( |
||||
|
base = base[s], |
||||
|
minpow = floor(panel_scales$x.range[1]), |
||||
|
maxpow = ceiling(panel_scales$x.range[2]), |
||||
|
majorTicks = panel_scales$x.major_source, |
||||
|
start = 0, |
||||
|
shortend = short, |
||||
|
midend = mid, |
||||
|
longend = long, |
||||
|
ticks_per_base = ticks_per_base[s], |
||||
|
delog = delog[s] |
||||
|
) |
||||
|
|
||||
|
if (scaled) { |
||||
|
if (!delog[s]) { |
||||
|
xticks$value <- log(xticks$value, base[s]) |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
names(xticks)[names(xticks) == "value"] <- "x" # Rename to 'x' for coordinates$transform |
||||
|
|
||||
|
xticks <- coord$transform(xticks, panel_scales) |
||||
|
|
||||
|
# Make the grobs |
||||
|
if (grepl("b", sides[s])) { |
||||
|
ticks$x_b <- with( |
||||
|
data, |
||||
|
segmentsGrob( |
||||
|
x0 = unit(xticks$x, "native"), |
||||
|
x1 = unit(xticks$x, "native"), |
||||
|
y0 = unit(xticks$start, "cm"), |
||||
|
y1 = unit(xticks$end, "cm"), |
||||
|
gp = gpar( |
||||
|
col = alpha(colour, alpha), |
||||
|
lty = linetype, |
||||
|
lwd = size * .pt |
||||
|
) |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
if (grepl("t", sides[s])) { |
||||
|
ticks$x_t <- with( |
||||
|
data, |
||||
|
segmentsGrob( |
||||
|
x0 = unit(xticks$x, "native"), |
||||
|
x1 = unit(xticks$x, "native"), |
||||
|
y0 = unit(1, "npc") - unit(xticks$start, "cm"), |
||||
|
y1 = unit(1, "npc") - unit(xticks$end, "cm"), |
||||
|
gp = gpar( |
||||
|
col = alpha(colour, alpha), |
||||
|
lty = linetype, |
||||
|
lwd = size * .pt |
||||
|
) |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
|
||||
|
if (grepl("[l|r]", sides[s])) { |
||||
|
yticks <- calc_ticks( |
||||
|
base = base[s], |
||||
|
minpow = floor(panel_scales$y.range[1]), |
||||
|
maxpow = ceiling(panel_scales$y.range[2]), |
||||
|
majorTicks = panel_scales$y.major_source, |
||||
|
start = 0, |
||||
|
shortend = short, |
||||
|
midend = mid, |
||||
|
longend = long, |
||||
|
ticks_per_base = ticks_per_base[s], |
||||
|
delog = delog[s] |
||||
|
) |
||||
|
|
||||
|
if (scaled) { |
||||
|
if (!delog[s]) { |
||||
|
yticks$value <- log(yticks$value, base[s]) |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
names(yticks)[names(yticks) == "value"] <- "y" # Rename to 'y' for coordinates$transform |
||||
|
yticks <- coord$transform(yticks, panel_scales) |
||||
|
|
||||
|
# Make the grobs |
||||
|
if (grepl("l", sides[s])) { |
||||
|
ticks$y_l <- with( |
||||
|
data, |
||||
|
segmentsGrob( |
||||
|
y0 = unit(yticks$y, "native"), |
||||
|
y1 = unit(yticks$y, "native"), |
||||
|
x0 = unit(yticks$start, "cm"), |
||||
|
x1 = unit(yticks$end, "cm"), |
||||
|
gp = gpar( |
||||
|
col = alpha(colour, alpha), |
||||
|
lty = linetype, lwd = size * .pt |
||||
|
) |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
if (grepl("r", sides[s])) { |
||||
|
ticks$y_r <- with( |
||||
|
data, |
||||
|
segmentsGrob( |
||||
|
y0 = unit(yticks$y, "native"), |
||||
|
y1 = unit(yticks$y, "native"), |
||||
|
x0 = unit(1, "npc") - unit(yticks$start, "cm"), |
||||
|
x1 = unit(1, "npc") - unit(yticks$end, "cm"), |
||||
|
gp = gpar( |
||||
|
col = alpha(colour, alpha), |
||||
|
lty = linetype, |
||||
|
lwd = size * .pt |
||||
|
) |
||||
|
) |
||||
|
) |
||||
|
} |
||||
|
} |
||||
|
} |
||||
|
gTree(children = do.call("gList", ticks)) |
||||
|
}, |
||||
|
default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1) |
||||
|
) |
||||
|
|
||||
|
|
||||
|
# Calculate the position of log tick marks Returns data frame with: - value: the |
||||
|
# position of the log tick on the data axis, for example 1, 2, ..., 9, 10, 20, ... |
||||
|
# - start: on the other axis, start position of the line (usually 0) - end: on the |
||||
|
# other axis, end position of the line (for example, .1, .2, or .3) |
||||
|
calc_ticks <- function(base = 10, |
||||
|
ticks_per_base = base - 1, |
||||
|
minpow = 0, |
||||
|
maxpow = minpow + 1, |
||||
|
majorTicks = 0, |
||||
|
start = 0, |
||||
|
shortend = 0.1, |
||||
|
midend = 0.2, |
||||
|
longend = 0.3, |
||||
|
delog = FALSE) { |
||||
|
|
||||
|
# Number of blocks of tick marks |
||||
|
reps <- maxpow - minpow |
||||
|
|
||||
|
# For base 10: 1, 2, 3, ..., 7, 8, 9, 1, 2, ... |
||||
|
ticknums <- rep(seq(1, base - 1, length.out = ticks_per_base), reps) |
||||
|
|
||||
|
# For base 10: 1, 1, 1, ..., 1, 1, 1, 2, 2, ... (for example) |
||||
|
powers <- rep(seq(minpow, maxpow - 1), each = ticks_per_base) |
||||
|
|
||||
|
ticks <- ticknums * base ^ powers |
||||
|
|
||||
|
ticks <- c(ticks, base ^ maxpow) # Add the last tick mark |
||||
|
|
||||
|
# Set all of the ticks short |
||||
|
tickend <- rep(shortend, length(ticks)) |
||||
|
|
||||
|
# Get the position within each cycle, 0, 1, 2, ..., 8, 0, 1, 2. ... |
||||
|
cycleIdx <- ticknums - 1 |
||||
|
|
||||
|
# Set the 'major' ticks long |
||||
|
tickend[cycleIdx == 0] <- longend |
||||
|
|
||||
|
# Where to place the longer tick marks that are between each base For base 10, this |
||||
|
# will be at each 5 |
||||
|
longtick_after_base <- floor(ticks_per_base / 2) |
||||
|
tickend[cycleIdx == longtick_after_base] <- midend |
||||
|
|
||||
|
if (delog) { |
||||
|
ticksCopy <- ticks |
||||
|
|
||||
|
regScale <- log(ticks, base) |
||||
|
|
||||
|
majorTicks <- sort( |
||||
|
unique( |
||||
|
c( |
||||
|
minpow, |
||||
|
regScale[which(regScale %in% majorTicks)], |
||||
|
maxpow, |
||||
|
majorTicks |
||||
|
) |
||||
|
) |
||||
|
) |
||||
|
|
||||
|
expandScale <- c() |
||||
|
|
||||
|
if (length(majorTicks) > 1) { |
||||
|
for (i in 1:(length(majorTicks) - 1)) { |
||||
|
expandScale <- c( |
||||
|
expandScale, |
||||
|
seq(majorTicks[i], majorTicks[i + 1], length.out = (ticks_per_base + 1)) |
||||
|
) |
||||
|
} |
||||
|
|
||||
|
ticks <- unique(expandScale) |
||||
|
|
||||
|
# Set all of the ticks short |
||||
|
tickend <- rep(shortend, length(ticks)) |
||||
|
|
||||
|
# Set the 'major' ticks long |
||||
|
tickend[which(ticks %in% majorTicks)] <- longend |
||||
|
} |
||||
|
} |
||||
|
|
||||
|
tickdf <- data.frame(value = ticks, start = start, end = tickend) |
||||
|
|
||||
|
tickdf |
||||
|
} |
@ -0,0 +1,101 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/annotation_ticks.r |
||||
|
\name{annotation_ticks} |
||||
|
\alias{annotation_ticks} |
||||
|
\title{Annotation: tick marks} |
||||
|
\usage{ |
||||
|
annotation_ticks(sides = "b", scale = "identity", scaled = TRUE, |
||||
|
short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm"), |
||||
|
colour = "black", size = 0.5, linetype = 1, alpha = 1, color = NULL, |
||||
|
ticks_per_base = NULL, ...) |
||||
|
} |
||||
|
\arguments{ |
||||
|
\item{sides}{a string that controls which sides of the plot the log ticks appear on. |
||||
|
It can be set to a string containing any of \code{"trbl"}, for top, right, |
||||
|
bottom, and left.} |
||||
|
|
||||
|
\item{scale}{character, vector of type of scale attributed to each corresponding side, Default: 'identity'} |
||||
|
|
||||
|
\item{scaled}{is the data already log-scaled? This should be \code{TRUE} |
||||
|
(default) when the data is already transformed with \code{log10()} or when |
||||
|
using \code{scale_y_log10}. It should be \code{FALSE} when using |
||||
|
\code{coord_trans(y = "log10")}.} |
||||
|
|
||||
|
\item{short}{a \code{\link[grid]{unit}} object specifying the length of the |
||||
|
short tick marks} |
||||
|
|
||||
|
\item{mid}{a \code{\link[grid]{unit}} object specifying the length of the |
||||
|
middle tick marks. In base 10, these are the "5" ticks.} |
||||
|
|
||||
|
\item{long}{a \code{\link[grid]{unit}} object specifying the length of the |
||||
|
long tick marks. In base 10, these are the "1" (or "10") ticks.} |
||||
|
|
||||
|
\item{colour}{Colour of the tick marks.} |
||||
|
|
||||
|
\item{size}{Thickness of tick marks, in mm.} |
||||
|
|
||||
|
\item{linetype}{Linetype of tick marks (\code{solid}, \code{dashed}, etc.)} |
||||
|
|
||||
|
\item{alpha}{The transparency of the tick marks.} |
||||
|
|
||||
|
\item{color}{An alias for \code{colour}.} |
||||
|
|
||||
|
\item{ticks_per_base}{integer, number of minor ticks between each pair of major ticks, Default: NULL} |
||||
|
|
||||
|
\item{...}{Other parameters passed on to the layer} |
||||
|
} |
||||
|
\description{ |
||||
|
This annotation adds tick marks to an axis |
||||
|
} |
||||
|
\details{ |
||||
|
If scale is of length one it will be replicated to the number of sides given, but if the |
||||
|
length of scale is larger than one it must match the number of sides given. |
||||
|
If ticks_per_base is set to NULL the function infers the number of ticks per base to be |
||||
|
the base of the scale - 1, for example log scale is base exp(1) and |
||||
|
log10 and identity are base 10. If ticks_per_base is given it follows the same logic as scale. |
||||
|
} |
||||
|
\examples{ |
||||
|
|
||||
|
p <- ggplot(msleep, aes(bodywt, brainwt)) + geom_point() |
||||
|
|
||||
|
# Default behavior |
||||
|
|
||||
|
# add identity scale minor ticks on y axis |
||||
|
p + annotation_ticks(sides = 'l') |
||||
|
|
||||
|
# add identity scale minor ticks on x,y axis |
||||
|
p + annotation_ticks(sides = 'lb') |
||||
|
|
||||
|
# Control number of minor ticks of each side independently |
||||
|
|
||||
|
# add identity scale minor ticks on x,y axis |
||||
|
p + annotation_ticks(sides = 'lb', ticks_per_base = c(10,5)) |
||||
|
|
||||
|
# log10 scale |
||||
|
p1 <- p + scale_x_log10() |
||||
|
|
||||
|
# add minor ticks on log10 scale |
||||
|
p1 + annotation_ticks(sides = 'b', scale = 'log10') |
||||
|
|
||||
|
# add minor ticks on both scales |
||||
|
p1 + annotation_ticks(sides = 'lb', scale = c('identity','log10')) |
||||
|
|
||||
|
# add minor ticks on both scales, but force x axis to be identity |
||||
|
p1 + annotation_ticks(sides = 'lb', scale = 'identity') |
||||
|
|
||||
|
# log scale |
||||
|
p2 <- p + scale_x_continuous(trans = 'log') |
||||
|
|
||||
|
# add minor ticks on log scale |
||||
|
p2 + annotation_ticks(sides = 'b', scale = 'log') |
||||
|
|
||||
|
# add minor ticks on both scales |
||||
|
p2 + annotation_ticks(sides = 'lb', scale = c('identity','log')) |
||||
|
|
||||
|
# add minor ticks on both scales, but force x axis to be identity |
||||
|
p2 + annotation_ticks(sides = 'lb', scale = 'identity') |
||||
|
|
||||
|
} |
||||
|
\author{ |
||||
|
Jonathan Sidi |
||||
|
} |
@ -1,10 +1,17 @@ |
|||||
% Generated by roxygen2: do not edit by hand |
% Generated by roxygen2: do not edit by hand |
||||
% Please edit documentation in R/geom_cartogram.r |
% Please edit documentation in R/annotation_ticks.r, R/geom_cartogram.r |
||||
\docType{data} |
\docType{data} |
||||
\name{GeomCartogram} |
\name{GeomTicks} |
||||
|
\alias{GeomTicks} |
||||
\alias{GeomCartogram} |
\alias{GeomCartogram} |
||||
\title{Geom Cartogram} |
\title{Base ggproto classes for ggplot2} |
||||
\description{ |
\description{ |
||||
|
If you are creating a new geom, stat, position, or scale in another package, |
||||
|
you'll need to extend from ggplot2::Geom, ggplot2::Stat, ggplot2::Position, or ggplot2::Scale. |
||||
|
|
||||
Geom Cartogram |
Geom Cartogram |
||||
} |
} |
||||
|
\seealso{ |
||||
|
\code{\link[ggplot2]{ggplot2-ggproto}} |
||||
|
} |
||||
\keyword{datasets} |
\keyword{datasets} |
||||
|
Loading…
Reference in new issue