From 53bacef3655089f88898e760f73b1885cc233ac6 Mon Sep 17 00:00:00 2001 From: Jonathan Sidi Date: Tue, 14 Nov 2017 07:56:03 -0500 Subject: [PATCH] rename Stepribbron to StatStepribbon and add annotation_ticks.r --- DESCRIPTION | 4 +- NAMESPACE | 3 + R/annotation_ticks.r | 377 ++++++++++++++++++++++++++++++++++++++++++++++++ R/stat-stepribbon.r | 4 +- README.Rmd | 16 ++ man/annotation_ticks.Rd | 101 +++++++++++++ man/ggplot2-ggproto.Rd | 13 +- 7 files changed, 512 insertions(+), 6 deletions(-) create mode 100644 R/annotation_ticks.r create mode 100644 man/annotation_ticks.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 21e4339..ef9ebbd 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NAMESPACE b/NAMESPACE index 2c2820f..4e7d079 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/annotation_ticks.r b/R/annotation_ticks.r new file mode 100644 index 0000000..371ed50 --- /dev/null +++ b/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 +} diff --git a/R/stat-stepribbon.r b/R/stat-stepribbon.r index d6605a7..dc18578 100644 --- a/R/stat-stepribbon.r +++ b/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"), diff --git a/README.Rmd b/README.Rmd index 5f4feef..2335caf 100644 --- a/README.Rmd +++ b/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). diff --git a/man/annotation_ticks.Rd b/man/annotation_ticks.Rd new file mode 100644 index 0000000..ab305fb --- /dev/null +++ b/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 +} diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 6d6125c..2423c4b 100644 --- a/man/ggplot2-ggproto.Rd +++ b/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}