#' Draw an area defined by an upper and lower diagonal
#'
#' The `geom_diagonal_wide()` function draws a *thick* diagonal, that is, a
#' polygon confined between a lower and upper [diagonal][geom_diagonal]. As with
#' the diagonal functions in `ggforce`, the wide diagonal variant is horizontal.
#'
#' @section Aesthetics:
#' geom_diagonal_wide understand the following aesthetics
#' (required aesthetics are in bold):
#'
#' - **x**
#' - **y**
#' - **group**
#' - color
#' - size
#' - linetype
#' - alpha
#' - lineend
#'
#' @inheritParams geom_shape
#' @inheritParams ggplot2::stat_identity
#'
#' @param n The number of points to create for each of the bounding diagonals
#'
#' @param strength The proportion to move the control point along the x-axis
#' towards the other end of the bezier curve
#'
#' @author Thomas Lin Pedersen
#'
#' @name geom_diagonal_wide
#' @rdname geom_diagonal_wide
#'
#' @examples
#' data <- data.frame(
#' x = c(1, 2, 2, 1, 2, 3, 3, 2),
#' y = c(1, 2, 3, 2, 3, 1, 2, 5),
#' group = c(1, 1, 1, 1, 2, 2, 2, 2)
#' )
#'
#' ggplot(data) +
#' geom_diagonal_wide(aes(x, y, group = group))
NULL
#' @rdname ggforce-extensions
#' @format NULL
#' @usage NULL
#' @importFrom ggplot2 ggproto Stat
#' @export
StatDiagonalWide <- ggproto('StatDiagonalWide', Stat,
setup_data = function(data, params) {
if (any(table(data$group) != 4)) {
stop('Each group must consist of 4 points')
}
data
},
compute_panel = function(data, scales, strength = 0.5, n = 100) {
data <- data[order(data$group, data$x, data$y), ]
lower <- data[c(TRUE, FALSE, TRUE, FALSE), ]
upper <- data[c(FALSE, TRUE, FALSE, TRUE), ]
lower <- add_controls(lower, strength)
upper <- add_controls(upper[rev(seq_len(nrow(upper))), ], strength)
lower <- StatBezier$compute_layer(lower, list(n = n))
upper <- StatBezier$compute_layer(upper, list(n = n))
diagonals <- rbind(lower, upper)
diagonals$index <- NULL
diagonals[order(diagonals$group), ]
},
required_aes = c('x', 'y', 'group'),
extra_params = c('na.rm', 'n', 'strength')
)
#' @rdname geom_diagonal_wide
#' @importFrom ggplot2 layer
#' @export
stat_diagonal_wide <- function(mapping = NULL, data = NULL, geom = "shape",
position = "identity", n = 100, strength = 0.5,
na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, ...) {
layer(
stat = StatDiagonalWide, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, n = n, strength = strength, ...)
)
}
#' @rdname geom_diagonal_wide
#' @importFrom ggplot2 layer
#' @export
geom_diagonal_wide <- function(mapping = NULL, data = NULL, stat = "diagonal_wide",
position = "identity", n = 100,
na.rm = FALSE, strength = 0.5,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(data = data, mapping = mapping, stat = stat, geom = GeomShape,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, n = n, strength = strength, ...))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.