Merge pull request #50 from yonicd/master

add geom_spikelines

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ggalt
 Title: Extra Coordinate Systems, 'Geoms', Statistical Transformations, Scales
     and Fonts for 'ggplot2'
-Version: 0.6.0
+Version: 0.6.1
 Maintainer: Bob Rudis <bob@rud.is>
 Authors@R: c(
       person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"), 
@@ -70,6 +70,7 @@ Collate:
     'geom_ash.r'
     'geom_bkde.r'
     'geom_bkde2d.r'
+    'geom_spikelines.R'
     'geom_dumbbell.R'
     'geom_cartogram.r'
     'geom_encircle.r'

NAMESPACE

@@ -15,6 +15,7 @@ export(GeomDumbbell)
 export(GeomEncircle)
 export(GeomHorizon)
 export(GeomLollipop)
+export(GeomSpikelines)
 export(GeomStateface)
 export(GeomTicks)
 export(GeomUbar)
@@ -41,6 +42,7 @@ export(geom_dumbbell)
 export(geom_encircle)
 export(geom_horizon)
 export(geom_lollipop)
+export(geom_spikelines)
 export(geom_stateface)
 export(geom_ubar)
 export(geom_xspline)

R/geom_spikelines.R

@@ -0,0 +1,119 @@
+#' @title Draw spikelines on a plot
+#' @description Segment reference lines that originate at an point
+#' @inheritParams ggplot2::geom_line
+#' @examples
+#'
+#' mtcars$name <- rownames(mtcars)
+#'
+#' p <- ggplot(data = mtcars, aes(x=mpg,y=disp)) + geom_point()
+#'
+#' p + geom_spikelines(data = mtcars[mtcars$carb==4,],linetype = 2)
+#'
+#' p + geom_spikelines(data = mtcars[mtcars$carb==4,],aes(colour = factor(gear)), linetype = 2)
+#'
+#' \dontrun{
+#' require(ggrepel)
+#' p + geom_spikelines(data = mtcars[mtcars$carb==4,],aes(colour = factor(gear)), linetype = 2) +
+#' ggrepel::geom_label_repel(data = mtcars[mtcars$carb==4,],aes(label = name))
+#' }
+#'
+#' @rdname geom_spikelines
+#' @author Jonathan Sidi
+#' @export
+
+geom_spikelines <- function(mapping = NULL, data = NULL,
+                         stat = "identity", position = "identity",
+                         ...,
+                         arrow = NULL,
+                         lineend = "butt",
+                         linejoin = "round",
+                         na.rm = FALSE,
+                         show.legend = NA,
+                         inherit.aes = TRUE) {
+  layer(
+    data = data,
+    mapping = mapping,
+    stat = stat,
+    geom = GeomSpikelines,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list(
+      arrow = arrow,
+      lineend = lineend,
+      linejoin = linejoin,
+      na.rm = na.rm,
+      ...
+    )
+  )
+}
+
+#' @rdname ggalt-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
+GeomSpikelines <- ggproto("GeomSpikelines", Geom,
+                       required_aes = c("x", "y"),
+                       non_missing_aes = c("linetype", "size", "shape"),
+                       default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
+
+                       draw_panel = function(data, panel_params, coord, arrow = NULL,
+                                             lineend = "butt", linejoin = "round", na.rm = FALSE) {
+
+                         data1 <- data
+                         data2 <- data
+
+                         data1$xend <- data$x
+                         data1$yend <- data$y
+                         data1$y <- 0
+
+
+                         data2$xend <- data$x
+                         data2$yend <- data$y
+                         data2$x <- 0
+
+                         data <- rbind(data1,data2)
+
+                         data <- remove_missing(data, na.rm = na.rm,
+                                                c("x", "y", "linetype", "size", "shape"),
+                                                name = "geom_spikelines")
+                         if (empty(data)) return(zeroGrob())
+
+                         if (coord$is_linear()) {
+                           coord <- coord$transform(data, panel_params)
+
+                           ret <- grid::segmentsGrob(coord$x, coord$y, coord$xend, coord$yend,
+                                                     default.units = "native",
+                                                     gp = grid::gpar(
+                                                       col = alpha(coord$colour, coord$alpha),
+                                                       fill = alpha(coord$colour, coord$alpha),
+                                                       lwd = coord$size * .pt,
+                                                       lty = coord$linetype,
+                                                       lineend = lineend,
+                                                       linejoin = linejoin
+                                                     ),
+                                                     arrow = arrow
+                           )
+
+                           return(ret)
+                         }
+
+                         data$group <- 1:nrow(data)
+                         starts <- subset(data, select = c(-xend, -yend))
+                         ends <- plyr::rename(subset(data, select = c(-x, -y)), c("xend" = "x", "yend" = "y"),
+                                              warn_missing = FALSE)
+
+                         pieces <- rbind(starts, ends)
+                         pieces <- pieces[order(pieces$group),]
+
+                         GeomPath$draw_panel(pieces, panel_params, coord, arrow = arrow,
+                                             lineend = lineend)
+                       },
+
+                       draw_key = draw_key_path
+)
+
+empty <- function (df)
+{
+  is.null(df) || nrow(df) == 0 || ncol(df) == 0
+}

README.Rmd

@@ -36,7 +36,9 @@ The following functions are implemented:
 - `geom_lollipop()`: Dead easy lollipops (horizontal or vertical)
 - `geom_dumbbell()` : Dead easy dumbbell plots
 - `stat_stepribbon()` : Step ribbons
-- `annotation_ticks()` : Add minor ticks to identity, exp(1) and exp(10) axis scales independently of each other.  
+- `annotation_ticks()` : Add minor ticks to identity, exp(1) and exp(10) axis scales independently of each other.
+- `geom_spikelines()` : Instead of geom_vline and geom_hline a pair of segments that originate from same c(x,y) are drawn to the respective axes.
+
 - plotly integration for a few of the ^^ geoms
 
 ### Installation
@@ -424,6 +426,18 @@ p1 <- p + scale_x_log10()
 p1 + annotation_ticks(sides = 'lb', scale = c('identity','log10'))
 ```
 
+```{r spikelines, message=FALSE, fig.width=7, fig.height=7}
+
+mtcars$name <- rownames(mtcars)
+
+p <- ggplot(data = mtcars, aes(x=mpg,y=disp)) + geom_point()
+
+p + 
+  geom_spikelines(data = mtcars[mtcars$carb==4,],aes(colour = factor(gear)), linetype = 2) + 
+  ggrepel::geom_label_repel(data = mtcars[mtcars$carb==4,],aes(label = name))
+
+```
+
 ### Code of Conduct
 
 Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). 

README.md

@@ -22,32 +22,53 @@ shifted histograms, a new map coordinate system based on the
 The following functions are implemented:
 
   - `geom_ubar` : Uniform width bar charts
+
   - `geom_horizon` : Horizon charts (modified from
     <https://github.com/AtherEnergy/ggTimeSeries>)
+
   - `coord_proj` : Like `coord_map`, only better (prbly shld use this
     with `geom_cartogram` as `geom_map`’s new defaults are ugh)
+
   - `geom_xspline` : Connect control points/observations with an
     X-spline
+
   - `stat_xspline` : Connect control points/observations with an
     X-spline
+
   - `geom_bkde` : Display a smooth density estimate (uses
     `KernSmooth::bkde`)
+
   - `geom_stateface`: Use ProPublica’s StateFace font in ggplot2 plots
+
   - `geom_bkde2d` : Contours from a 2d density estimate. (uses
     `KernSmooth::bkde2D`)
+
   - `stat_bkde` : Display a smooth density estimate (uses
     `KernSmooth::bkde`)
+
   - `stat_bkde2d` : Contours from a 2d density estimate. (uses
     `KernSmooth::bkde2D`)
+
   - `stat_ash` : Compute and display a univariate averaged shifted
     histogram (polynomial kernel) (uses `ash::ash1`/`ash::bin1`)
+
   - `geom_encircle`: Automatically enclose points in a polygon
+
   - `byte_format`: + helpers. e.g. turn `10000` into `10 Kb`
+
   - `geom_lollipop()`: Dead easy lollipops (horizontal or vertical)
+
   - `geom_dumbbell()` : Dead easy dumbbell plots
+
   - `stat_stepribbon()` : Step ribbons
+
   - `annotation_ticks()` : Add minor ticks to identity, exp(1) and
-    exp(10) axis scales independently of each other.  
+    exp(10) axis scales independently of each other.
+
+  - `geom_spikelines()` : Instead of geom\_vline and geom\_hline a pair
+    of segments that originate from same c(x,y) are drawn to the
+    respective axes.
+
   - plotly integration for a few of the ^^ geoms
 
 ### Installation
@@ -68,7 +89,7 @@ library(ggalt)
 
 # current verison
 packageVersion("ggalt")
-## [1] '0.6.0'
+## [1] '0.6.1'
 
 set.seed(1492)
 dat <- data.frame(x=c(1:10, 1:10, 1:10),
@@ -609,6 +630,19 @@ p1 + annotation_ticks(sides = 'lb', scale = c('identity','log10'))
 
 <img src="README_figs/README-annoticks-3.png" width="672" />
 
+``` r
+
+mtcars$name <- rownames(mtcars)
+
+p <- ggplot(data = mtcars, aes(x=mpg,y=disp)) + geom_point()
+
+p + 
+  geom_spikelines(data = mtcars[mtcars$carb==4,],aes(colour = factor(gear)), linetype = 2) + 
+  ggrepel::geom_label_repel(data = mtcars[mtcars$carb==4,],aes(label = name))
+```
+
+<img src="README_figs/README-spikelines-1.png" width="672" />
+
 ### Code of Conduct
 
 Please note that this project is released with a [Contributor Code of

man/geom_dumbbell.Rd

@@ -11,24 +11,24 @@ geom_dumbbell(mapping = NULL, data = NULL, ..., colour_x = NULL,
   position = "identity")
 }
 \arguments{
-\item{mapping}{Set of aesthetic mappings created by \code{\link{aes}} or
-\code{\link{aes_}}. If specified and \code{inherit.aes = TRUE} (the
+\item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or
+\code{\link[=aes_]{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:
+options:
 
-   If \code{NULL}, the default, the data is inherited from the plot
-   data as specified in the call to \code{\link{ggplot}}.
+If \code{NULL}, the default, the data is inherited from the plot
+data as specified in the call to \code{\link[=ggplot]{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{data.frame}, or other object, will override the plot
+data. All objects will be fortified to produce a data frame. See
+\code{\link[=fortify]{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.}
+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{...}{other arguments passed on to \code{\link{layer}}. These are
 often aesthetics, used to set an aesthetic to a fixed value, like
@@ -52,12 +52,14 @@ 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.}
+\code{FALSE} never includes, and \code{TRUE} always includes.
+It can also be a named logical vector to finely select the aesthetics to
+display.}
 
 \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}}.}
+the default plot specification, e.g. \code{\link[=borders]{borders()}}.}
 
 \item{position}{Position adjustment, either as a string, or the result of a
 call to a position adjustment function.}

man/geom_spikelines.Rd

@@ -0,0 +1,85 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/geom_spikelines.R
+\name{geom_spikelines}
+\alias{geom_spikelines}
+\title{Draw spikelines on a plot}
+\usage{
+geom_spikelines(mapping = NULL, data = NULL, stat = "identity",
+  position = "identity", ..., arrow = NULL, lineend = "butt",
+  linejoin = "round", na.rm = FALSE, show.legend = NA,
+  inherit.aes = TRUE)
+}
+\arguments{
+\item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or
+\code{\link[=aes_]{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]{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]{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]{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{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.}
+
+\item{lineend}{Line end style (round, butt, square).}
+
+\item{linejoin}{Line join style (round, mitre, bevel).}
+
+\item{na.rm}{If \code{FALSE}, the default, missing values are removed with
+a warning. If \code{TRUE}, missing values are silently removed.}
+
+\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.
+It can also be a named logical vector to finely select the aesthetics to
+display.}
+
+\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]{borders()}}.}
+}
+\description{
+Segment reference lines that originate at an point
+}
+\examples{
+
+mtcars$name <- rownames(mtcars)
+
+p <- ggplot(data = mtcars, aes(x=mpg,y=disp)) + geom_point()
+
+p + geom_spikelines(data = mtcars[mtcars$carb==4,],linetype = 2)
+
+p + geom_spikelines(data = mtcars[mtcars$carb==4,],aes(colour = factor(gear)), linetype = 2)
+
+\dontrun{
+require(ggrepel)
+p + geom_spikelines(data = mtcars[mtcars$carb==4,],aes(colour = factor(gear)), linetype = 2) +
+ggrepel::geom_label_repel(data = mtcars[mtcars$carb==4,],aes(label = name))
+}
+
+}
+\author{
+Jonathan Sidi
+}

man/ggalt-ggproto.Rd

@@ -1,8 +1,8 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/coord_proj.r, R/geom_ash.r, R/geom_bkde.r,
-%   R/geom_bkde2d.r, R/geom_dumbbell.R, R/geom_encircle.r, R/geom_lollipop.r,
-%   R/geom_xspline.r, R/geom_xspline2.r, R/geom_ubar.r, R/stat-stepribbon.r,
-%   R/stateface.r
+%   R/geom_bkde2d.r, R/geom_spikelines.R, R/geom_dumbbell.R, R/geom_encircle.r,
+%   R/geom_lollipop.r, R/geom_xspline.r, R/geom_xspline2.r, R/geom_ubar.r,
+%   R/stat-stepribbon.r, R/stateface.r
 \docType{data}
 \name{CoordProj}
 \alias{CoordProj}
@@ -11,6 +11,7 @@
 \alias{StatBkde}
 \alias{GeomBkde2d}
 \alias{StatBkde2d}
+\alias{GeomSpikelines}
 \alias{GeomDumbbell}
 \alias{GeomEncircle}
 \alias{GeomLollipop}