Browse Source

Merge pull request #45 from jonocarroll/master

added position dodging to dumbbell plots (ref: #18 and #32).
master
boB Rudis 6 years ago
committed by GitHub
parent
commit
a3804e9d1a
No known key found for this signature in database GPG Key ID: 4AEE18F83AFDEB23
  1. 2
      DESCRIPTION
  2. 2
      NAMESPACE
  3. 21
      R/geom_dumbbell.R
  4. 122
      R/position-dodgev.R
  5. 48
      man/geom_dumbbell.Rd
  6. 39
      man/position-dodgev.Rd
  7. 18
      vignettes/ggalt_examples.Rmd

2
DESCRIPTION

@ -43,6 +43,7 @@ Imports:
utils,
graphics,
grDevices,
plyr,
dplyr,
RColorBrewer,
KernSmooth,
@ -64,6 +65,7 @@ Collate:
'coord_proj.r'
'formatters.r'
'fortify.r'
'position-dodgev.R'
'geom2plotly.r'
'geom_ash.r'
'geom_bkde.r'

2
NAMESPACE

@ -22,6 +22,7 @@ export(GeomXSpline2)
export(GeomXspline)
export(Kb)
export(Mb)
export(PositionDodgev)
export(StatAsh)
export(StatBkde)
export(StatBkde2d)
@ -44,6 +45,7 @@ export(geom_stateface)
export(geom_ubar)
export(geom_xspline)
export(load_stateface)
export(position_dodgev)
export(show_stateface)
export(stat_ash)
export(stat_bkde)

21
R/geom_dumbbell.R

@ -20,6 +20,8 @@
#' @param colour_xend the colour of the end point
#' @param dot_guide if \code{TRUE}, a leading dotted line will be placed before the left-most dumbbell point
#' @param dot_guide_size,dot_guide_colour singe-value aesthetics for \code{dot_guide}
#' @param position Position adjustment, either as a string, or the result of a
#' call to a position adjustment function.
#' @inheritParams ggplot2::layer
#' @export
#' @examples
@ -34,19 +36,34 @@
#' labs(x=NULL, y=NULL, title="ggplot2 geom_dumbbell with dot guide") +
#' theme_minimal() +
#' theme(panel.grid.major.x=element_line(size=0.05))
#'
#' ## with vertical dodging
#' df2 <- data.frame(trt = c(LETTERS[1:5], "D"),
#' l = c(20, 40, 10, 30, 50, 40),
#' r = c(70, 50, 30, 60, 80, 70))
#'
#' ggplot(df2, aes(y=trt, x=l, xend=r)) +
#' geom_dumbbell(size=3, color="#e3e2e1",
#' colour_x = "#5b8124", colour_xend = "#bad744",
#' dot_guide=TRUE, dot_guide_size=0.25,
#' position=position_dodgev(height=0.4)) +
#' labs(x=NULL, y=NULL, title="ggplot2 geom_dumbbell with dot guide") +
#' theme_minimal() +
#' theme(panel.grid.major.x=element_line(size=0.05))
geom_dumbbell <- function(mapping = NULL, data = NULL, ...,
colour_x = NULL, size_x = NULL,
colour_xend = NULL, size_xend = NULL,
dot_guide = FALSE, dot_guide_size = NULL,
dot_guide_colour = NULL,
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
position = "identity") {
layer(
data = data,
mapping = mapping,
stat = "identity",
geom = GeomDumbbell,
position = "identity",
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(

122
R/position-dodgev.R

@ -0,0 +1,122 @@
#' Vertically dodge position
#' @rdname position-dodgev
#' @author @@ggstance authors
#' @note position-dodgev(): unmodified from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
#' @export
position_dodgev <- function(height = NULL) {
ggplot2::ggproto(NULL, PositionDodgev, height = height)
}
#' @rdname position-dodgev
#' @author @@ggstance authors
#' @note PositionDodgev(): based on from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
#' @format NULL
#' @usage NULL
#' @export
PositionDodgev <- ggplot2::ggproto("PositionDodgev", ggplot2::Position,
required_aes = "y",
height = NULL,
setup_params = function(self, data) {
if (is.null(data$ymin) && is.null(data$ymax) && is.null(self$height)) {
warning("Height not defined. Set with `position_dodgev(height = ?)`",
call. = FALSE)
}
list(height = self$height)
},
compute_panel = function(data, params, scales) {
collidev(data, params$height, "position_dodgev", pos_dodgev, check.height = FALSE)
}
)
#' @rdname position-dodgev
#' @author @@ggstance authors
#' @note pos_dodgev(): unmodified from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
pos_dodgev <- function(df, height) {
n <- length(unique(df$group))
if (n == 1) return(df)
if (!all(c("ymin", "ymax") %in% names(df))) {
df$ymin <- df$y
df$ymax <- df$y
}
d_height <- max(df$ymax - df$ymin)
# df <- data.frame(n = c(2:5, 10, 26), div = c(4, 3, 2.666666, 2.5, 2.2, 2.1))
# ggplot(df, aes(n, div)) + geom_point()
# Have a new group index from 1 to number of groups.
# This might be needed if the group numbers in this set don't include all of 1:n
groupidx <- match(df$group, sort(unique(df$group)))
# Find the center for each group, then use that to calculate ymin and lmax
df$y <- df$y + height * ((groupidx - 0.5) / n - .5)
df$ymin <- df$y - d_height / n / 2
df$ymax <- df$y + d_height / n / 2
df
}
#' @rdname position-dodgev
#' @author @@ggstance authors
#' @note collidev(): based on lionel-/ggstance/R/position.R 73f521384ae8ea277db5f7d5a2854004aa18f947
collidev <- function(data, height = NULL, name, strategy, ..., check.height = TRUE, reverse = FALSE) {
# Determine height
if (!is.null(height)) {
# Width set manually
if (!(all(c("ymin", "ymax") %in% names(data)))) {
data$ymin <- data$y - height / 2
data$ymax <- data$y + height / 2
}
} else {
if (!(all(c("ymin", "ymax") %in% names(data)))) {
data$ymin <- data$y
data$ymax <- data$y
}
# Width determined from data, must be floating point constant
heights <- unique(data$ymax - data$ymin)
heights <- heights[!is.na(heights)]
# # Suppress warning message since it's not reliable
# if (!zero_range(range(heights))) {
# warning(name, " requires constant height: output may be incorrect",
# call. = FALSE)
# }
height <- heights[1]
}
# Reorder by x position, then on group. The default stacking order reverses
# the group in order to match the legend order.
if (reverse) {
data <- data[order(data$ymin, data$group), ]
} else {
data <- data[order(data$ymin, -data$group), ]
}
# Check for overlap
intervals <- as.numeric(t(unique(data[c("ymin", "ymax")])))
intervals <- intervals[!is.na(intervals)]
if (length(unique(intervals)) > 1 & any(diff(scale(intervals)) < -1e-6)) {
warning(name, " requires non-overlapping y intervals", call. = FALSE)
# This is where the algorithm from [L. Wilkinson. Dot plots.
# The American Statistician, 1999.] should be used
}
data$group <- seq_len(nrow(data)) ## reset grouping
if (!is.null(data$xmax)) {
plyr::ddply(data, "ymin", strategy, ..., height = height)
} else if (!is.null(data$x)) {
data$xmax <- data$x
data <- plyr::ddply(data, "ymin", strategy, ..., height = height)
data$x <- data$xmax
data$yend <- data$y ## ALLOW FOR A YEND COLUMN
data
} else {
stop("Neither x nor xmax defined")
}
}

48
man/geom_dumbbell.Rd

@ -7,27 +7,28 @@
geom_dumbbell(mapping = NULL, data = NULL, ..., colour_x = NULL,
size_x = NULL, colour_xend = NULL, size_xend = NULL,
dot_guide = FALSE, dot_guide_size = NULL, dot_guide_colour = NULL,
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE)
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
position = "identity")
}
\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
\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:
options:
If \code{NULL}, the default, the data is inherited from the plot
data as specified in the call to \code{\link[=ggplot]{ggplot()}}.
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]{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}} 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
@ -51,14 +52,15 @@ 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.
It can also be a named logical vector to finely select the aesthetics to
display.}
\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]{borders()}}.}
the default plot specification, e.g. \code{\link{borders}}.}
\item{position}{Position adjustment, either as a string, or the result of a
call to a position adjustment function.}
}
\description{
The dumbbell geom is used to create dumbbell charts.
@ -84,4 +86,18 @@ ggplot(df, aes(y=trt, x=l, xend=r)) +
labs(x=NULL, y=NULL, title="ggplot2 geom_dumbbell with dot guide") +
theme_minimal() +
theme(panel.grid.major.x=element_line(size=0.05))
## with vertical dodging
df2 <- data.frame(trt = c(LETTERS[1:5], "D"),
l = c(20, 40, 10, 30, 50, 40),
r = c(70, 50, 30, 60, 80, 70))
ggplot(df2, aes(y=trt, x=l, xend=r)) +
geom_dumbbell(size=3, color="#e3e2e1",
colour_x = "#5b8124", colour_xend = "#bad744",
dot_guide=TRUE, dot_guide_size=0.25,
position=position_dodgev(height=0.4)) +
labs(x=NULL, y=NULL, title="ggplot2 geom_dumbbell with dot guide") +
theme_minimal() +
theme(panel.grid.major.x=element_line(size=0.05))
}

39
man/position-dodgev.Rd

@ -0,0 +1,39 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/position-dodgev.R
\docType{data}
\name{position_dodgev}
\alias{position_dodgev}
\alias{PositionDodgev}
\alias{pos_dodgev}
\alias{collidev}
\title{Vertically dodge position}
\usage{
position_dodgev(height = NULL)
pos_dodgev(df, height)
collidev(data, height = NULL, name, strategy, ..., check.height = TRUE,
reverse = FALSE)
}
\description{
Vertically dodge position
}
\note{
position-dodgev(): unmodified from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
PositionDodgev(): based on from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
pos_dodgev(): unmodified from lionel-/ggstance/R/position-dodgev.R 73f521384ae8ea277db5f7d5a2854004aa18f947
collidev(): based on lionel-/ggstance/R/position.R 73f521384ae8ea277db5f7d5a2854004aa18f947
}
\author{
@ggstance authors
@ggstance authors
@ggstance authors
@ggstance authors
}
\keyword{datasets}

18
vignettes/ggalt_examples.Rmd

@ -263,3 +263,21 @@ ggplot(df, aes(y=trt, x=l, xend=r)) +
theme(panel.grid.major.x=element_line(size=0.05)) +
theme(panel.grid.major.y=element_blank())
```
with optional vertical dodging
```{r dumbbellv, message=FALSE, fig.width=7, fig.height=2.5}
df2 <- data.frame(trt = c(LETTERS[1:5], "D"),
l = c(20, 40, 10, 30, 50, 40),
r = c(70, 50, 30, 60, 80, 70))
ggplot(df2, aes(y=trt, x=l, xend=r)) +
geom_dumbbell(size=3, color="#e3e2e1",
colour_x = "#5b8124", colour_xend = "#bad744",
dot_guide=TRUE, dot_guide_size=0.25,
position=position_dodgev(height=0.8)) +
labs(x=NULL, y=NULL, title="ggplot2 geom_dumbbell with dot guide") +
theme_minimal() +
theme(panel.grid.major.x=element_line(size=0.05))
```

Loading…
Cancel
Save