Browse Source

rename Stepribbron to StatStepribbon and add annotation_ticks.r

pull/38/head
Jonathan Sidi 5 years ago
parent
commit
53bacef365
  1. 4
      DESCRIPTION
  2. 3
      NAMESPACE
  3. 377
      R/annotation_ticks.r
  4. 4
      R/stat-stepribbon.r
  5. 16
      README.Rmd
  6. 101
      man/annotation_ticks.Rd
  7. 13
      man/ggplot2-ggproto.Rd

4
DESCRIPTION

@ -11,7 +11,8 @@ Authors@R: c(
person("Rosen", "Matev", role="ctb", comment="Original annotate_textp implementation on stackoverflow"),
person("ProPublica", role="dtc", comment="StateFace font"),
person("Aditya", "Kothari", role=c("aut", "ctb"), comment="Core functionality of horizon plots"),
person("Ather", role="dtc", comment="Core functionality of horizon plots")
person("Ather", role="dtc", comment="Core functionality of horizon plots"),
person("Jonathan","Sidi", role=c("aut","ctb"), comment="Annotation ticks")
)
Description: A compendium of new geometries, coordinate systems, statistical
transformations, scales and fonts for 'ggplot2', including splines, 1d and 2d densities,
@ -57,6 +58,7 @@ RoxygenNote: 6.0.1
VignetteBuilder: knitr
Collate:
'annotate_textp.r'
'annotation_ticks.r'
'coord_proj.r'
'formatters.r'
'fortify.r'

3
NAMESPACE

@ -16,6 +16,7 @@ export(GeomEncircle)
export(GeomHorizon)
export(GeomLollipop)
export(GeomStateface)
export(GeomTicks)
export(GeomUbar)
export(GeomXSpline2)
export(GeomXspline)
@ -28,6 +29,7 @@ export(StatHorizon)
export(StatStepribbon)
export(StatXspline)
export(annotate_textp)
export(annotation_ticks)
export(byte_format)
export(bytes)
export(coord_proj)
@ -58,6 +60,7 @@ import(ash)
import(ggplot2)
import(grDevices)
import(graphics)
import(grid)
import(maps)
import(proj4)
import(utils)

377
R/annotation_ticks.r

@ -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
}

4
R/stat-stepribbon.r

@ -33,7 +33,7 @@ stat_stepribbon <- function(mapping=NULL, data=NULL, geom="ribbon",
ggplot2::layer(
data = data,
mapping = mapping,
stat = Stepribbon,
stat = StatStepribbon,
geom = geom,
position = position,
show.legend = show.legend,
@ -53,7 +53,7 @@ stat_stepribbon <- function(mapping=NULL, data=NULL, geom="ribbon",
#' @export
StatStepribbon <-
ggproto(
"StepRibbon", Stat,
"StatStepRibbon", Stat,
required_aes = c("x", "ymin", "ymax"),

16
README.Rmd

@ -405,6 +405,22 @@ ggplot(df, aes(y=trt, x=l, xend=r)) +
theme(panel.grid.major.x=element_line(size=0.05))
```
```{r annoticks, message=FALSE, fig.width=7, fig.height=2.5}
p <- ggplot(msleep, aes(bodywt, brainwt)) + geom_point()
# 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')
# log10 scale
p1 <- p + scale_x_log10()
# add minor ticks on both scales
p1 + annotation_ticks(sides = 'lb', scale = c('identity','log10'))
```
### Code of Conduct
Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md).

101
man/annotation_ticks.Rd

@ -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
}

13
man/ggplot2-ggproto.Rd

@ -1,10 +1,17 @@
% 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}
\name{GeomCartogram}
\name{GeomTicks}
\alias{GeomTicks}
\alias{GeomCartogram}
\title{Geom Cartogram}
\title{Base ggproto classes for ggplot2}
\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
}
\seealso{
\code{\link[ggplot2]{ggplot2-ggproto}}
}
\keyword{datasets}

Loading…
Cancel
Save