#' @include shape.R
NULL
#' Arcs and wedges as polygons
#'
#' This set of stats and geoms makes it possible to draw arcs and wedges as
#' known from pie and donut charts as well as more specialized plottypes such as
#' sunburst plots.
#'
#' @details An arc bar is the thick version of an arc; that is, a circle segment
#' drawn as a polygon in the same way as a rectangle is a thick version of a
#' line. A wedge is a special case of an arc where the inner radius is 0. As
#' opposed to applying coord_polar to a stacked bar chart, these layers are
#' drawn in cartesian space, which allows for transformations not possible with
#' the native ggplot2 approach. Most notable of these are the option to explode
#' arcs and wedgets away from their center point, thus detaching it from the
#' main pie/donut.
#'
#' @section Aesthetics:
#' geom_arc_bar understand the following aesthetics (required aesthetics are in
#' bold):
#'
#' - **x0**
#' - **y0**
#' - **r0**
#' - **r**
#' - **start** - when using stat_arc_bar
#' - **end** - when using stat_arc_bar
#' - **amount** - when using stat_pie
#' - explode
#' - color
#' - fill
#' - size
#' - linetype
#' - alpha
#'
#'
#' @section Computed variables:
#' \describe{
#' \item{x, y}{x and y coordinates for the polygon}
#' }
#'
#' \describe{
#' \item{x, y}{The start coordinates for the segment}
#' }
#'
#' @inheritParams ggplot2::geom_polygon
#' @inheritParams ggplot2::stat_identity
#'
#' @param n The number of points used to draw a full circle. The number of
#' points on each arc will then be calculated as n / span-of-arc
#'
#' @param sep The separation between arcs in pie/donut charts
#'
#' @author Thomas Lin Pedersen
#'
#' @name geom_arc_bar
#' @rdname geom_arc_bar
#'
#' @examples
#' # If you know the angle spans to plot it is easy
#' arcs <- data.frame(
#' start = seq(0, 2*pi, length.out=11)[-11],
#' end = seq(0, 2*pi, length.out=11)[-1],
#' r = rep(1:2, 5)
#' )
#'
#' # Behold the arcs
#' ggplot() + geom_arc_bar(aes(x0=0, y0=0, r0=r-1, r=r, start=start, end=end,
#' fill = r),
#' data=arcs)
#'
#' # If you got values for a pie chart, use stat_pie
#' states <- c('eaten', "eaten but said you didn't", 'cat took it', 'for tonight',
#' 'will decompose slowly')
#' pie <- data.frame(
#' state = factor(rep(states, 2), levels = states),
#' type = rep(c('Pie', 'Donut'), each = 5),
#' r0 = rep(c(0, 0.8), each = 5),
#' focus=rep(c(0.2, 0, 0, 0, 0), 2),
#' amount = c(4,3, 1, 1.5, 6, 6, 1, 2, 3, 2),
#' stringsAsFactors = FALSE
#' )
#'
#' # Look at the cakes
#' ggplot() + geom_arc_bar(aes(x0=0, y0=0, r0=r0, r=1, amount=amount,
#' fill=state, explode=focus),
#' data=pie, stat='pie') +
#' facet_wrap(~type, ncol=1) +
#' coord_fixed() +
#' theme_no_axes() +
#' scale_fill_brewer('', type='qual')
#'
#' @seealso [geom_arc()] for drawing arcs as lines
#'
NULL
#' @rdname ggforce-extensions
#' @format NULL
#' @usage NULL
#' @importFrom ggplot2 ggproto Stat
#' @export
StatArcBar <- ggproto('StatArcBar', Stat,
compute_panel = function(data, scales, n = 360) {
arcPaths(data, n)
},
required_aes = c('x0', 'y0', 'r0','r', 'start', 'end')
)
#' @rdname geom_arc_bar
#' @importFrom ggplot2 layer
#' @export
stat_arc_bar <- function(mapping = NULL, data = NULL, geom = "arc_bar",
position = "identity", n = 360, na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatArcBar, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, n = n, ...)
)
}
#' @rdname ggforce-extensions
#' @format NULL
#' @usage NULL
#' @importFrom ggplot2 ggproto Stat
#' @importFrom dplyr group_by_ do
#' @export
StatPie <- ggproto('StatPie', Stat,
compute_panel = function(data, scales, n = 360, sep = 0) {
data <- data %>% group_by_(~x0, ~y0) %>%
do({
angles <- cumsum(.$amount)
seps <- cumsum(sep * seq_along(angles))
if (max(seps) >= 2*pi) {
stop('Total separation exceeds circle circumference. Try lowering "sep"')
}
angles <- angles/max(angles) * (2*pi - max(seps))
data.frame(
as.data.frame(.),
start = c(0, angles[-length(angles)]) + c(0, seps[-length(seps)]) + sep/2,
end = angles + seps -sep/2,
stringsAsFactors = FALSE
)
})
arcPaths(as.data.frame(data), n)
},
required_aes = c('x0', 'y0', 'r0','r', 'amount')
)
#' @rdname geom_arc_bar
#' @importFrom ggplot2 layer
#' @export
stat_pie <- function(mapping = NULL, data = NULL, geom = "arc_bar",
position = "identity", n = 360, sep = 0, na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = StatPie, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, n = n, sep = sep, ...)
)
}
#' @rdname ggforce-extensions
#' @format NULL
#' @usage NULL
#' @importFrom ggplot2 ggproto
#' @export
GeomArcBar <- ggproto('GeomArcBar', GeomShape,
default_aes = list(colour = 'black', fill = NA, size = 0.5, linetype = 1, alpha = NA)
)
#' @rdname geom_arc_bar
#' @importFrom ggplot2 layer
#' @inheritParams geom_shape
#' @export
geom_arc_bar <- function(mapping = NULL, data = NULL, stat = "arc_bar",
position = "identity", n = 360, expand = 0, radius = 0, na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(data = data, mapping = mapping, stat = stat, geom = GeomArcBar,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, n = n, ...))
}
arcPaths <- function(data, n) {
trans <- radial_trans(c(0, 1), c(0, 2*pi), pad = 0)
data <- data[data$start != data$end, ]
data$nControl <- ceiling(n/(2*pi) * abs(data$end - data$start))
data$nControl[data$nControl < 3] <- 3
extraData <- !names(data) %in% c('r0', 'r', 'start', 'end')
paths <- lapply(seq_len(nrow(data)), function(i) {
path <- data.frame(
a = seq(data$start[i], data$end[i], length.out = data$nControl[i]),
r = data$r[i]
)
if ('r0' %in% names(data)) {
if (data$r0[i] != 0) {
path <- rbind(
path,
data.frame(a = rev(path$a), r = data$r0[i])
)
} else {
path <- rbind(
path,
data.frame(a = data$start[i], r = 0)
)
}
}
path$group <- i
path$index <- seq(0, 1, length.out = nrow(path))
path <- cbind(path, data[rep(i, nrow(path)), extraData])
})
paths <- do.call(rbind, paths)
paths <- cbind(paths[, !names(paths) %in% c('r', 'a')],
trans$transform(paths$r, paths$a))
paths$x <- paths$x + paths$x0
paths$y <- paths$y + paths$y0
if ('explode' %in% names(data)) {
exploded <- data$explode != 0
if (any(exploded)) {
exploder <- trans$transform(
data$explode[exploded],
data$start[exploded] + (data$end[exploded] - data$start[exploded])/2
)
explodedPaths <- paths$group %in% which(exploded)
exploderInd <- as.integer(factor(paths$group[explodedPaths]))
paths$x[explodedPaths] <-
paths$x[explodedPaths] + exploder$x[exploderInd]
paths$y[explodedPaths] <-
paths$y[explodedPaths] + exploder$y[exploderInd]
}
}
paths[, !names(paths) %in% c('x0', 'y0', 'exploded')]
}
arcPaths2 <- function(data, n) {
trans <- radial_trans(c(0, 1), c(0, 2*pi), pad = 0)
fullCirc <- n/(2*pi)
extraData <- setdiff(names(data), c('r', 'x0', 'y0', 'end', 'group', 'PANEL'))
hasExtra <- length(extraData) != 0
extraTemplate <- data[NA, extraData, drop = FALSE][1, , drop = FALSE]
paths <- lapply(split(seq_len(nrow(data)), data$group), function(i) {
if (length(i) != 2) {
stop('Arcs must be defined by two end points', call. = FALSE)
}
if (data$r[i[1]] != data$r[i[2]] ||
data$x0[i[1]] != data$x0[i[2]] ||
data$y0[i[1]] != data$y0[i[2]]) {
stop('Both end points must be at same radius and with same center', call. = FALSE)
}
if (data$end[i[1]] == data$end[i[2]]) return()
nControl <- ceiling(fullCirc * abs(diff(data$end[i])))
if (nControl < 3) nControl <- 3
path <- data.frame(
a = seq(data$end[i[1]], data$end[i[2]], length.out = nControl),
r = data$r[i[1]],
x0 = data$x0[i[1]],
y0 = data$y0[i[1]],
group = data$group[i[1]],
index = seq(0, 1, length.out = nControl),
.interp = c(FALSE, rep(TRUE, nControl -2), FALSE),
PANEL = data$PANEL[i[1]]
)
if (hasExtra) {
path <- cbind(path, extraTemplate[rep(1, nControl), , drop = FALSE])
path[1, extraData] <- data[i[1], extraData]
path[nControl, extraData] <- data[i[2], extraData]
}
path
})
paths <- do.call(rbind, paths)
paths <- cbind(paths[, !names(paths) %in% c('r', 'a')],
trans$transform(paths$r, paths$a))
paths$x <- paths$x + paths$x0
paths$y <- paths$y + paths$y0
paths[, !names(paths) %in% c('x0', 'y0')]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.