diff --git a/DESCRIPTION b/DESCRIPTION index 753e7dd49a..fee91269c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -98,6 +98,9 @@ Collate: 'geom-.R' 'annotation-custom.R' 'annotation-logticks.R' + 'scale-type.R' + 'layer.R' + 'make-constructor.R' 'geom-polygon.R' 'geom-map.R' 'annotation-map.R' @@ -142,6 +145,7 @@ Collate: 'geom-col.R' 'geom-path.R' 'geom-contour.R' + 'geom-point.R' 'geom-count.R' 'geom-crossbar.R' 'geom-segment.R' @@ -160,7 +164,6 @@ Collate: 'geom-jitter.R' 'geom-label.R' 'geom-linerange.R' - 'geom-point.R' 'geom-pointrange.R' 'geom-quantile.R' 'geom-rug.R' @@ -186,7 +189,6 @@ Collate: 'guide-colorbar.R' 'guide-colorsteps.R' 'guide-custom.R' - 'layer.R' 'guide-none.R' 'guide-old.R' 'guides-.R' @@ -236,7 +238,6 @@ Collate: 'scale-shape.R' 'scale-size.R' 'scale-steps.R' - 'scale-type.R' 'scale-view.R' 'scale-viridis.R' 'scales-.R' diff --git a/NAMESPACE b/NAMESPACE index b58765ecc1..b19f894131 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -93,6 +93,8 @@ S3method(limits,character) S3method(limits,factor) S3method(limits,numeric) S3method(makeContext,dotstackGrob) +S3method(make_constructor,Geom) +S3method(make_constructor,Stat) S3method(merge_element,default) S3method(merge_element,element) S3method(merge_element,element_blank) @@ -498,6 +500,7 @@ export(layer_grob) export(layer_scales) export(layer_sf) export(lims) +export(make_constructor) export(map_data) export(margin) export(margin_auto) diff --git a/R/geom-bar.R b/R/geom-bar.R index b0901502d9..4aeda453c7 100644 --- a/R/geom-bar.R +++ b/R/geom-bar.R @@ -1,3 +1,45 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-rect.R +GeomBar <- ggproto( + "GeomBar", GeomRect, + required_aes = c("x", "y"), + + # These aes columns are created by setup_data(). They need to be listed here so + # that GeomRect$handle_na() properly removes any bars that fall outside the defined + # limits, not just those for which x and y are outside the limits + non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), + + default_aes = aes(!!!GeomRect$default_aes, width = 0.9), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, + + extra_params = c("just", "na.rm", "orientation"), + + setup_data = function(self, data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) + data <- compute_data_size( + data, size = params$width, + default = self$default_aes$width, zero = FALSE + ) + data$just <- params$just %||% 0.5 + data <- transform(data, + ymin = pmin(y, 0), ymax = pmax(y, 0), + xmin = x - width * just, xmax = x + width * (1 - just), + width = NULL, just = NULL + ) + flip_data(data, params$flipped_aes) + }, + + rename_size = FALSE +) + #' Bar charts #' #' There are two types of bar charts: `geom_bar()` and `geom_col()`. @@ -48,6 +90,8 @@ #' @param geom,stat Override the default connection between `geom_bar()` and #' `stat_count()`. For more information about overriding these connections, #' see how the [stat][layer_stats] and [geom][layer_geoms] arguments work. +#' @param lineend Line end style (round, butt, square). +#' @param linejoin Line join style (round, mitre, bevel). #' @examples #' # geom_bar is designed to make it easy to create bar charts that show #' # counts (or sums of weights) @@ -92,68 +136,7 @@ #' ggplot(df, aes(x, y)) + geom_col(just = 0.5) #' # Columns begin on the first day of the month #' ggplot(df, aes(x, y)) + geom_col(just = 1) -geom_bar <- function(mapping = NULL, data = NULL, - stat = "count", position = "stack", - ..., - just = 0.5, - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomBar, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - just = just, - na.rm = na.rm, - orientation = orientation, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @include geom-rect.R -GeomBar <- ggproto("GeomBar", GeomRect, - required_aes = c("x", "y"), - - # These aes columns are created by setup_data(). They need to be listed here so - # that GeomRect$handle_na() properly removes any bars that fall outside the defined - # limits, not just those for which x and y are outside the limits - non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), - - default_aes = aes(!!!GeomRect$default_aes, width = 0.9), - - setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(data, params) - params - }, - - extra_params = c("just", "na.rm", "orientation"), - - setup_data = function(self, data, params) { - data$flipped_aes <- params$flipped_aes - data <- flip_data(data, params$flipped_aes) - data <- compute_data_size( - data, size = params$width, - default = self$default_aes$width, zero = FALSE - ) - data$just <- params$just %||% 0.5 - data <- transform(data, - ymin = pmin(y, 0), ymax = pmax(y, 0), - xmin = x - width * just, xmax = x + width * (1 - just), - width = NULL, just = NULL - ) - flip_data(data, params$flipped_aes) - }, - - rename_size = FALSE +geom_bar <- make_constructor( + GeomBar, + stat = "count", position = "stack", just = 0.5 ) diff --git a/R/geom-bin2d.R b/R/geom-bin2d.R index e0c78ab5e4..8f308db067 100644 --- a/R/geom-bin2d.R +++ b/R/geom-bin2d.R @@ -1,6 +1,12 @@ #' @include geom-tile.R NULL +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomBin2d <- ggproto("GeomBin2d", GeomTile) + #' Heatmap of 2d bin counts #' #' Divides the plane into rectangles, counts the number of cases in @@ -17,6 +23,8 @@ NULL #' `geom_bin_2d()` and `stat_bin_2d()`. For more information about overriding #' these connections, see how the [stat][layer_stats] and [geom][layer_geoms] #' arguments work. +#' @param lineend Line end style (round, butt, square). +#' @param linejoin Line join style (round, mitre, bevel). #' @seealso [stat_bin_hex()] for hexagonal binning #' @examples #' d <- ggplot(diamonds, aes(x, y)) + xlim(4, 10) + ylim(4, 10) @@ -29,35 +37,9 @@ NULL #' #' # Or by specifying the width of the bins #' d + geom_bin_2d(binwidth = c(0.1, 0.1)) -geom_bin_2d <- function(mapping = NULL, data = NULL, - stat = "bin2d", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomBin2d, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} +geom_bin_2d <- make_constructor(GeomBin2d, stat = "bin2d") #' @export #' @rdname geom_bin_2d #' @usage NULL geom_bin2d <- geom_bin_2d - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -GeomBin2d <- ggproto("GeomBin2d", GeomTile) diff --git a/R/geom-col.R b/R/geom-col.R index 77c756f573..8a4fc2eaf9 100644 --- a/R/geom-col.R +++ b/R/geom-col.R @@ -1,29 +1,3 @@ -#' @export -#' @rdname geom_bar -geom_col <- function(mapping = NULL, data = NULL, - position = "stack", - ..., - just = 0.5, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - - layer( - data = data, - mapping = mapping, - stat = "identity", - geom = GeomCol, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - just = just, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -31,3 +5,7 @@ geom_col <- function(mapping = NULL, data = NULL, #' @include geom-rect.R # TODO: deprecate this GeomCol <- ggproto("GeomCol", GeomBar) + +#' @export +#' @rdname geom_bar +geom_col <- make_constructor(GeomCol, position = "stack", just = 0.5) diff --git a/R/geom-contour.R b/R/geom-contour.R index a73bc3a135..14a4b7c40e 100644 --- a/R/geom-contour.R +++ b/R/geom-contour.R @@ -1,3 +1,26 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-path.R +GeomContour <- ggproto( + "GeomContour", GeomPath, + default_aes = aes( + weight = 1, + colour = from_theme(accent), + linewidth = from_theme(linewidth), + linetype = from_theme(linetype), + alpha = NA + ) +) + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-polygon.R +GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon) + #' 2D contours of a 3D surface #' #' @description @@ -26,6 +49,10 @@ #' #' Overrides `binwidth` and `bins`. By default, this is a vector of length #' ten with [pretty()] breaks. +#' @param rule Either `"evenodd"` or `"winding"`. If polygons with holes are +#' being drawn (using the `subgroup` aesthetic) this argument defines how the +#' hole coordinates are interpreted. See the examples in [grid::pathGrob()] for +#' an explanation. #' @seealso [geom_density_2d()]: 2d density contours #' @export #' @examples @@ -56,87 +83,16 @@ #' v + geom_raster(aes(fill = density)) + #' geom_contour(colour = "white") #' } -geom_contour <- function(mapping = NULL, data = NULL, - stat = "contour", position = "identity", - ..., - bins = NULL, - binwidth = NULL, - breaks = NULL, - lineend = "butt", - linejoin = "round", - linemitre = 10, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomContour, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - breaks = breaks, - lineend = lineend, - linejoin = linejoin, - linemitre = linemitre, - na.rm = na.rm, - ... - ) - ) -} +geom_contour <- make_constructor( + GeomContour, stat = "contour", + # Passed to contour stat: + bins = NULL, binwidth = NULL, breaks = NULL +) #' @rdname geom_contour #' @export -geom_contour_filled <- function(mapping = NULL, data = NULL, - stat = "contour_filled", position = "identity", - ..., - bins = NULL, - binwidth = NULL, - breaks = NULL, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomContourFilled, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - breaks = breaks, - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @include geom-path.R -GeomContour <- ggproto("GeomContour", GeomPath, - default_aes = aes( - weight = 1, - colour = from_theme(accent), - linewidth = from_theme(linewidth), - linetype = from_theme(linetype), - alpha = NA - ) +geom_contour_filled <- make_constructor( + GeomContourFilled, stat = "contour_filled", + # Passed to contour_filled stat: + bins = NULL, binwidth = NULL, breaks = NULL ) - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @include geom-polygon.R -GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon) - diff --git a/R/geom-count.R b/R/geom-count.R index 37b2e2922e..32ae897c9f 100644 --- a/R/geom-count.R +++ b/R/geom-count.R @@ -1,3 +1,6 @@ +#' @include geom-point.R +NULL + #' Count overlapping points #' #' This is a variant [geom_point()] that counts the number of @@ -43,23 +46,4 @@ #' scale_size_area(max_size = 10) #' d + geom_count(aes(size = after_stat(prop), group = clarity)) + #' scale_size_area(max_size = 10) -geom_count <- function(mapping = NULL, data = NULL, - stat = "sum", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomPoint, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} +geom_count <- make_constructor(GeomPoint, stat = "sum") diff --git a/R/geom-curve.R b/R/geom-curve.R index e1c38d1cd4..e64f937bbb 100644 --- a/R/geom-curve.R +++ b/R/geom-curve.R @@ -1,39 +1,3 @@ -#' @inheritParams grid::curveGrob -#' @export -#' @rdname geom_segment -geom_curve <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - curvature = 0.5, - angle = 90, - ncp = 5, - arrow = NULL, - arrow.fill = NULL, - lineend = "butt", - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomCurve, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - arrow = arrow, - arrow.fill = arrow.fill, - curvature = curvature, - angle = angle, - ncp = ncp, - lineend = lineend, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @include geom-segment.R #' @format NULL @@ -41,41 +5,46 @@ geom_curve <- function(mapping = NULL, data = NULL, #' @export GeomCurve <- ggproto("GeomCurve", GeomSegment, - default_aes = aes( - colour = from_theme(ink), - linewidth = from_theme(linewidth), - linetype = from_theme(linetype), - alpha = NA - ), + default_aes = aes( + colour = from_theme(ink), + linewidth = from_theme(linewidth), + linetype = from_theme(linetype), + alpha = NA + ), - draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90, - ncp = 5, arrow = NULL, arrow.fill = NULL, lineend = "butt", na.rm = FALSE) { + draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90, + ncp = 5, arrow = NULL, arrow.fill = NULL, lineend = "butt", na.rm = FALSE) { - if (!coord$is_linear()) { - cli::cli_warn("{.fn geom_curve} is not implemented for non-linear coordinates") - } - data <- remove_missing( - data, na.rm = na.rm, - c("x", "y", "xend", "yend", "linetype", "linewidth"), - name = "geom_curve" - ) + if (!coord$is_linear()) { + cli::cli_warn("{.fn geom_curve} is not implemented for non-linear coordinates") + } + data <- remove_missing( + data, na.rm = na.rm, + c("x", "y", "xend", "yend", "linetype", "linewidth"), + name = "geom_curve" + ) - trans <- coord$transform(data, panel_params) + trans <- coord$transform(data, panel_params) - arrow.fill <- arrow.fill %||% trans$colour + arrow.fill <- arrow.fill %||% trans$colour - curveGrob( - trans$x, trans$y, trans$xend, trans$yend, - default.units = "native", - curvature = curvature, angle = angle, ncp = ncp, - square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE, - gp = gg_par( - col = alpha(trans$colour, trans$alpha), - fill = alpha(arrow.fill, trans$alpha), - lwd = trans$linewidth, - lty = trans$linetype, - lineend = lineend), - arrow = arrow - ) - } + curveGrob( + trans$x, trans$y, trans$xend, trans$yend, + default.units = "native", + curvature = curvature, angle = angle, ncp = ncp, + square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE, + gp = gg_par( + col = alpha(trans$colour, trans$alpha), + fill = alpha(arrow.fill, trans$alpha), + lwd = trans$linewidth, + lty = trans$linetype, + lineend = lineend), + arrow = arrow + ) + } ) + +#' @inheritParams grid::curveGrob +#' @export +#' @rdname geom_segment +geom_curve <- make_constructor(GeomCurve) diff --git a/R/geom-density.R b/R/geom-density.R index a4a7754f2e..460996c197 100644 --- a/R/geom-density.R +++ b/R/geom-density.R @@ -1,3 +1,16 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-ribbon.R +GeomDensity <- ggproto( + "GeomDensity", GeomArea, + default_aes = defaults( + aes(fill = NA, weight = 1, colour = from_theme(ink), alpha = NA), + GeomArea$default_aes + ) +) + #' Smoothed density estimates #' #' Computes and draws kernel density estimate, which is a smoothed version of @@ -59,41 +72,10 @@ #' ggplot(diamonds, aes(carat, after_stat(count), fill = cut)) + #' geom_density(position = "fill") #' } -geom_density <- function(mapping = NULL, data = NULL, - stat = "density", position = "identity", - ..., - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE, - outline.type = "upper") { - outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomDensity, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - orientation = orientation, - outline.type = outline.type, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @include geom-ribbon.R -GeomDensity <- ggproto("GeomDensity", GeomArea, - default_aes = defaults( - aes(fill = NA, weight = 1, colour = from_theme(ink), alpha = NA), - GeomArea$default_aes +geom_density <- make_constructor( + GeomDensity, stat = "density", + checks = exprs( + outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) ) ) + diff --git a/R/geom-errorbar.R b/R/geom-errorbar.R index 3e50c59877..2c2aec05ff 100644 --- a/R/geom-errorbar.R +++ b/R/geom-errorbar.R @@ -1,62 +1,9 @@ -#' @export -#' @rdname geom_linerange -geom_errorbar <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomErrorbar, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - orientation = orientation, - ... - ) - ) -} - -#' @export -#' @rdname geom_linerange -#' @note -#' `geom_errorbarh()` is `r lifecycle::badge("deprecated")`. Use -#' `geom_errorbar(orientation = "y")` instead. -geom_errorbarh <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - orientation = "y", - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - deprecate_soft0( - "3.5.2", "geom_errobarh()", "geom_errorbar(orientation = \"y\")", - id = "no-more-errorbarh" - ) - geom_errorbar( - mapping = mapping, - data = data, - stat = stat, - position = position, - ..., - orientation = orientation, - na.rm = na.rm, - show.legend = show.legend, - inherit.aes = inherit.aes - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -GeomErrorbar <- ggproto("GeomErrorbar", Geom, +GeomErrorbar <- ggproto( + "GeomErrorbar", Geom, default_aes = aes( colour = from_theme(ink), @@ -85,7 +32,7 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, zero = FALSE, discrete = TRUE ) data <- transform(data, - xmin = x - width / 2, xmax = x + width / 2, width = NULL + xmin = x - width / 2, xmax = x + width / 2, width = NULL ) flip_data(data, params$flipped_aes) }, @@ -113,7 +60,6 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, rename_size = TRUE ) - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -128,3 +74,20 @@ GeomErrorbarh <- ggproto( GeomLinerange$setup_params(data, params) } ) + +#' @export +#' @rdname geom_linerange +geom_errorbar <- make_constructor(GeomErrorbar, orientation = NA) + +#' @export +#' @rdname geom_linerange +#' @note +#' `geom_errorbarh()` is `r lifecycle::badge("deprecated")`. Use +#' `geom_errorbar(orientation = "y")` instead. +geom_errorbarh <- function(..., orientation = "y") { + deprecate_soft0( + "3.5.2", "geom_errobarh()", "geom_errorbar(orientation = \"y\")", + id = "no-more-errorbarh" + ) + geom_errorbar(..., orientation = orientation) +} diff --git a/R/geom-function.R b/R/geom-function.R index c566731996..94e5ce2aaa 100644 --- a/R/geom-function.R +++ b/R/geom-function.R @@ -1,3 +1,26 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-path.R +GeomFunction <- ggproto("GeomFunction", GeomPath, + draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL, + lineend = "butt", linejoin = "round", linemitre = 10, + na.rm = FALSE) { + groups <- unique0(data$group) + if (length(groups) > 1) { + cli::cli_warn(c( + "Multiple drawing groups in {.fn {snake_class(self)}}", + "i" = "Did you use the correct {.field group}, {.field colour}, or {.field fill} aesthetics?" + )) + } + + ggproto_parent(GeomPath, self)$draw_panel( + data, panel_params, coord, arrow, arrow.fill, lineend, linejoin, linemitre, na.rm + ) + } +) + #' Draw a function as a continuous curve #' #' Computes and draws a function as a continuous curve. This makes it easy to @@ -62,47 +85,7 @@ #' geom_function(fun = dnorm, colour = "red", xlim=c(-7, 7)) #' #' @export -geom_function <- function(mapping = NULL, data = NULL, stat = "function", - position = "identity", ..., na.rm = FALSE, - show.legend = NA, inherit.aes = TRUE) { - if (is.null(data)) { - data <- ensure_nonempty_data - } - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomFunction, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @include geom-path.R -GeomFunction <- ggproto("GeomFunction", GeomPath, - draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL, - lineend = "butt", linejoin = "round", linemitre = 10, - na.rm = FALSE) { - groups <- unique0(data$group) - if (length(groups) > 1) { - cli::cli_warn(c( - "Multiple drawing groups in {.fn {snake_class(self)}}", - "i" = "Did you use the correct {.field group}, {.field colour}, or {.field fill} aesthetics?" - )) - } - - ggproto_parent(GeomPath, self)$draw_panel( - data, panel_params, coord, arrow, arrow.fill, lineend, linejoin, linemitre, na.rm - ) - } +geom_function <- make_constructor( + GeomFunction, stat = "function", + checks = exprs(data <- data %||% ensure_nonempty_data) ) diff --git a/R/geom-hex.R b/R/geom-hex.R index 5add9250c8..31c09ef671 100644 --- a/R/geom-hex.R +++ b/R/geom-hex.R @@ -1,56 +1,3 @@ -#' Hexagonal heatmap of 2d bin counts -#' -#' Divides the plane into regular hexagons, counts the number of cases in -#' each hexagon, and then (by default) maps the number of cases to the hexagon -#' fill. Hexagon bins avoid the visual artefacts sometimes generated by -#' the very regular alignment of [geom_bin_2d()]. -#' -#' @eval rd_aesthetics("geom", "hex") -#' @eval rd_aesthetics("stat", "binhex") -#' @seealso [stat_bin_2d()] for rectangular binning -#' @param geom,stat Override the default connection between `geom_hex()` and -#' `stat_bin_hex()`. For more information about overriding these connections, -#' see how the [stat][layer_stats] and [geom][layer_geoms] arguments work. -#' @export -#' @inheritParams layer -#' @inheritParams geom_point -#' @export -#' @examples -#' d <- ggplot(diamonds, aes(carat, price)) -#' d + geom_hex() -#' -#' \donttest{ -#' # You can control the size of the bins by specifying the number of -#' # bins in each direction: -#' d + geom_hex(bins = 10) -#' d + geom_hex(bins = 30) -#' -#' # Or by specifying the width of the bins -#' d + geom_hex(binwidth = c(1, 1000)) -#' d + geom_hex(binwidth = c(.1, 500)) -#' } -geom_hex <- function(mapping = NULL, data = NULL, - stat = "binhex", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomHex, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -118,3 +65,39 @@ GeomHex <- ggproto("GeomHex", Geom, rename_size = TRUE ) + +#' Hexagonal heatmap of 2d bin counts +#' +#' Divides the plane into regular hexagons, counts the number of cases in +#' each hexagon, and then (by default) maps the number of cases to the hexagon +#' fill. Hexagon bins avoid the visual artefacts sometimes generated by +#' the very regular alignment of [geom_bin_2d()]. +#' +#' @eval rd_aesthetics("geom", "hex") +#' @eval rd_aesthetics("stat", "binhex") +#' @seealso [stat_bin_2d()] for rectangular binning +#' @param geom,stat Override the default connection between `geom_hex()` and +#' `stat_bin_hex()`. For more information about overriding these connections, +#' see how the [stat][layer_stats] and [geom][layer_geoms] arguments work. +#' @export +#' @inheritParams layer +#' @inheritParams geom_point +#' @param lineend Line end style (round, butt, square). +#' @param linejoin Line join style (round, mitre, bevel). +#' @param linemitre Line mitre limit (number greater than 1). +#' @export +#' @examples +#' d <- ggplot(diamonds, aes(carat, price)) +#' d + geom_hex() +#' +#' \donttest{ +#' # You can control the size of the bins by specifying the number of +#' # bins in each direction: +#' d + geom_hex(bins = 10) +#' d + geom_hex(bins = 30) +#' +#' # Or by specifying the width of the bins +#' d + geom_hex(binwidth = c(1, 1000)) +#' d + geom_hex(binwidth = c(.1, 500)) +#' } +geom_hex <- make_constructor(GeomHex, stat = 'binhex') diff --git a/R/geom-histogram.R b/R/geom-histogram.R index 7bd832b611..107a252b08 100644 --- a/R/geom-histogram.R +++ b/R/geom-histogram.R @@ -133,31 +133,8 @@ #' ggplot(economics_long, aes(value)) + #' facet_wrap(~variable, scales = 'free_x') + #' geom_histogram(binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3))) -geom_histogram <- function(mapping = NULL, data = NULL, - stat = "bin", position = "stack", - ..., - binwidth = NULL, - bins = NULL, - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomBar, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - binwidth = binwidth, - bins = bins, - na.rm = na.rm, - orientation = orientation, - pad = FALSE, - ... - ) - ) -} +geom_histogram <- make_constructor( + GeomBar, stat = "bin", position = "stack", + # Passed to bin stat: + binwidth = NULL, bins = NULL, orientation = NA +) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index 71c0799971..134c9a179a 100644 --- a/R/geom-linerange.R +++ b/R/geom-linerange.R @@ -1,3 +1,47 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomLinerange <- ggproto( + "GeomLinerange", Geom, + + default_aes = aes( + colour = from_theme(ink), + linewidth = from_theme(linewidth), + linetype = from_theme(linetype), + alpha = NA + ), + + draw_key = draw_key_linerange, + + required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) + # if flipped_aes == TRUE then y, xmin, xmax is present + if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% c(names(data), names(params))))) { + cli::cli_abort("Either, {.field x}, {.field ymin}, and {.field ymax} {.emph or} {.field y}, {.field xmin}, and {.field xmax} must be supplied.") + } + params + }, + + extra_params = c("na.rm", "orientation"), + + setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data + }, + + draw_panel = function(data, panel_params, coord, lineend = "butt", flipped_aes = FALSE, na.rm = FALSE) { + data <- flip_data(data, flipped_aes) + data <- transform(data, xend = x, y = ymin, yend = ymax) + data <- flip_data(data, flipped_aes) + ggname("geom_linerange", GeomSegment$draw_panel(data, panel_params, coord, lineend = lineend, na.rm = na.rm)) + }, + + rename_size = TRUE +) + #' Vertical intervals: lines, crossbars & errorbars #' #' Various ways of representing a vertical interval defined by `x`, @@ -62,68 +106,4 @@ #' aes(ymin = lower, ymax = upper), #' position = position_dodge2(width = 0.5, padding = 0.5) #' ) -geom_linerange <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomLinerange, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - orientation = orientation, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -GeomLinerange <- ggproto("GeomLinerange", Geom, - - default_aes = aes( - colour = from_theme(ink), - linewidth = from_theme(linewidth), - linetype = from_theme(linetype), - alpha = NA - ), - - draw_key = draw_key_linerange, - - required_aes = c("x|y", "ymin|xmin", "ymax|xmax"), - - setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) - # if flipped_aes == TRUE then y, xmin, xmax is present - if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% c(names(data), names(params))))) { - cli::cli_abort("Either, {.field x}, {.field ymin}, and {.field ymax} {.emph or} {.field y}, {.field xmin}, and {.field xmax} must be supplied.") - } - params - }, - - extra_params = c("na.rm", "orientation"), - - setup_data = function(data, params) { - data$flipped_aes <- params$flipped_aes - data - }, - - draw_panel = function(data, panel_params, coord, lineend = "butt", flipped_aes = FALSE, na.rm = FALSE) { - data <- flip_data(data, flipped_aes) - data <- transform(data, xend = x, y = ymin, yend = ymax) - data <- flip_data(data, flipped_aes) - ggname("geom_linerange", GeomSegment$draw_panel(data, panel_params, coord, lineend = lineend, na.rm = na.rm)) - }, - - rename_size = TRUE -) +geom_linerange <- make_constructor(GeomLinerange, orientation = NA) diff --git a/R/geom-path.R b/R/geom-path.R index fe930363a6..24876954d8 100644 --- a/R/geom-path.R +++ b/R/geom-path.R @@ -1,133 +1,3 @@ -#' Connect observations -#' -#' `geom_path()` connects the observations in the order in which they appear -#' in the data. `geom_line()` connects them in order of the variable on the -#' x axis. `geom_step()` creates a stairstep plot, highlighting exactly -#' when changes occur. The `group` aesthetic determines which cases are -#' connected together. -#' -#' An alternative parameterisation is [geom_segment()], where each line -#' corresponds to a single case which provides the start and end coordinates. -#' -#' @eval rd_orientation() -#' -#' @eval rd_aesthetics("geom", "path") -#' @inheritParams layer -#' @inheritParams geom_bar -#' @param lineend Line end style (round, butt, square). -#' @param linejoin Line join style (round, mitre, bevel). -#' @param linemitre Line mitre limit (number greater than 1). -#' @param arrow Arrow specification, as created by [grid::arrow()]. -#' @param arrow.fill fill colour to use for the arrow head (if closed). `NULL` -#' means use `colour` aesthetic. -#' @seealso -#' [geom_polygon()]: Filled paths (polygons); -#' [geom_segment()]: Line segments -#' @section Missing value handling: -#' `geom_path()`, `geom_line()`, and `geom_step()` handle `NA` as follows: -#' -#' * If an `NA` occurs in the middle of a line, it breaks the line. No warning -#' is shown, regardless of whether `na.rm` is `TRUE` or `FALSE`. -#' * If an `NA` occurs at the start or the end of the line and `na.rm` is `FALSE` -#' (default), the `NA` is removed with a warning. -#' * If an `NA` occurs at the start or the end of the line and `na.rm` is `TRUE`, -#' the `NA` is removed silently, without warning. -#' @export -#' @examples -#' # geom_line() is suitable for time series -#' ggplot(economics, aes(date, unemploy)) + geom_line() -#' # separate by colour and use "timeseries" legend key glyph -#' ggplot(economics_long, aes(date, value01, colour = variable)) + -#' geom_line(key_glyph = "timeseries") -#' -#' # You can get a timeseries that run vertically by setting the orientation -#' ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") -#' -#' # geom_step() is useful when you want to highlight exactly when -#' # the y value changes -#' recent <- economics[economics$date > as.Date("2013-01-01"), ] -#' ggplot(recent, aes(date, unemploy)) + geom_line() -#' ggplot(recent, aes(date, unemploy)) + geom_step() -#' -#' # geom_path lets you explore how two variables are related over time, -#' # e.g. unemployment and personal savings rate -#' m <- ggplot(economics, aes(unemploy/pop, psavert)) -#' m + geom_path() -#' m + geom_path(aes(colour = as.numeric(date))) -#' -#' # Changing parameters ---------------------------------------------- -#' ggplot(economics, aes(date, unemploy)) + -#' geom_line(colour = "red") -#' -#' # Use the arrow parameter to add an arrow to the line -#' # See ?arrow for more details -#' c <- ggplot(economics, aes(x = date, y = pop)) -#' c + geom_line(arrow = arrow()) -#' c + geom_line( -#' arrow = arrow(angle = 15, ends = "both", type = "closed") -#' ) -#' -#' # Control line join parameters -#' df <- data.frame(x = 1:3, y = c(4, 1, 9)) -#' base <- ggplot(df, aes(x, y)) -#' base + geom_path(linewidth = 10) -#' base + geom_path(linewidth = 10, lineend = "round") -#' base + geom_path(linewidth = 10, linejoin = "mitre", lineend = "butt") -#' -#' # You can use NAs to break the line. -#' df <- data.frame(x = 1:5, y = c(1, 2, NA, 4, 5)) -#' ggplot(df, aes(x, y)) + geom_point() + geom_line() -#' -#' \donttest{ -#' # Setting line type vs colour/size -#' # Line type needs to be applied to a line as a whole, so it can -#' # not be used with colour or size that vary across a line -#' x <- seq(0.01, .99, length.out = 100) -#' df <- data.frame( -#' x = rep(x, 2), -#' y = c(qlogis(x), 2 * qlogis(x)), -#' group = rep(c("a","b"), -#' each = 100) -#' ) -#' p <- ggplot(df, aes(x=x, y=y, group=group)) -#' # These work -#' p + geom_line(linetype = 2) -#' p + geom_line(aes(colour = group), linetype = 2) -#' p + geom_line(aes(colour = x)) -#' # But this doesn't -#' should_stop(p + geom_line(aes(colour = x), linetype=2)) -#' } -geom_path <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - lineend = "butt", - linejoin = "round", - linemitre = 10, - arrow = NULL, - arrow.fill = NULL, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomPath, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - lineend = lineend, - linejoin = linejoin, - linemitre = linemitre, - arrow = arrow, - arrow.fill = arrow.fill, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -245,50 +115,13 @@ GeomPath <- ggproto("GeomPath", Geom, rename_size = TRUE ) -# Trim false values from left and right: keep all values from -# first TRUE to last TRUE -keep_mid_true <- function(x) { - first <- match(TRUE, x) - 1 - if (is.na(first)) { - return(rep(FALSE, length(x))) - } - - last <- length(x) - match(TRUE, rev(x)) + 1 - c( - rep(FALSE, first), - rep(TRUE, last - first), - rep(FALSE, length(x) - last) - ) -} - - -#' @export -#' @rdname geom_path -geom_line <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", na.rm = FALSE, orientation = NA, - show.legend = NA, inherit.aes = TRUE, ...) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomLine, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - orientation = orientation, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-path.R -GeomLine <- ggproto("GeomLine", GeomPath, +GeomLine <- ggproto( + "GeomLine", GeomPath, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) params @@ -304,38 +137,13 @@ GeomLine <- ggproto("GeomLine", GeomPath, } ) -#' @param direction direction of stairs: 'vh' for vertical then horizontal, -#' 'hv' for horizontal then vertical, or 'mid' for step half-way between -#' adjacent x-values. -#' @export -#' @rdname geom_path -geom_step <- function(mapping = NULL, data = NULL, stat = "identity", - position = "identity", direction = "hv", - na.rm = FALSE, orientation = NA, show.legend = NA, - inherit.aes = TRUE, ...) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomStep, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - direction = direction, - orientation = orientation, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export #' @include geom-path.R -GeomStep <- ggproto("GeomStep", GeomPath, +GeomStep <- ggproto( + "GeomStep", GeomPath, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) params @@ -359,6 +167,134 @@ GeomStep <- ggproto("GeomStep", GeomPath, } ) +#' Connect observations +#' +#' `geom_path()` connects the observations in the order in which they appear +#' in the data. `geom_line()` connects them in order of the variable on the +#' x axis. `geom_step()` creates a stairstep plot, highlighting exactly +#' when changes occur. The `group` aesthetic determines which cases are +#' connected together. +#' +#' An alternative parameterisation is [geom_segment()], where each line +#' corresponds to a single case which provides the start and end coordinates. +#' +#' @eval rd_orientation() +#' +#' @eval rd_aesthetics("geom", "path") +#' @inheritParams layer +#' @inheritParams geom_bar +#' @param lineend Line end style (round, butt, square). +#' @param linejoin Line join style (round, mitre, bevel). +#' @param linemitre Line mitre limit (number greater than 1). +#' @param arrow Arrow specification, as created by [grid::arrow()]. +#' @param arrow.fill fill colour to use for the arrow head (if closed). `NULL` +#' means use `colour` aesthetic. +#' @seealso +#' [geom_polygon()]: Filled paths (polygons); +#' [geom_segment()]: Line segments +#' @section Missing value handling: +#' `geom_path()`, `geom_line()`, and `geom_step()` handle `NA` as follows: +#' +#' * If an `NA` occurs in the middle of a line, it breaks the line. No warning +#' is shown, regardless of whether `na.rm` is `TRUE` or `FALSE`. +#' * If an `NA` occurs at the start or the end of the line and `na.rm` is `FALSE` +#' (default), the `NA` is removed with a warning. +#' * If an `NA` occurs at the start or the end of the line and `na.rm` is `TRUE`, +#' the `NA` is removed silently, without warning. +#' @export +#' @examples +#' # geom_line() is suitable for time series +#' ggplot(economics, aes(date, unemploy)) + geom_line() +#' # separate by colour and use "timeseries" legend key glyph +#' ggplot(economics_long, aes(date, value01, colour = variable)) + +#' geom_line(key_glyph = "timeseries") +#' +#' # You can get a timeseries that run vertically by setting the orientation +#' ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") +#' +#' # geom_step() is useful when you want to highlight exactly when +#' # the y value changes +#' recent <- economics[economics$date > as.Date("2013-01-01"), ] +#' ggplot(recent, aes(date, unemploy)) + geom_line() +#' ggplot(recent, aes(date, unemploy)) + geom_step() +#' +#' # geom_path lets you explore how two variables are related over time, +#' # e.g. unemployment and personal savings rate +#' m <- ggplot(economics, aes(unemploy/pop, psavert)) +#' m + geom_path() +#' m + geom_path(aes(colour = as.numeric(date))) +#' +#' # Changing parameters ---------------------------------------------- +#' ggplot(economics, aes(date, unemploy)) + +#' geom_line(colour = "red") +#' +#' # Use the arrow parameter to add an arrow to the line +#' # See ?arrow for more details +#' c <- ggplot(economics, aes(x = date, y = pop)) +#' c + geom_line(arrow = arrow()) +#' c + geom_line( +#' arrow = arrow(angle = 15, ends = "both", type = "closed") +#' ) +#' +#' # Control line join parameters +#' df <- data.frame(x = 1:3, y = c(4, 1, 9)) +#' base <- ggplot(df, aes(x, y)) +#' base + geom_path(linewidth = 10) +#' base + geom_path(linewidth = 10, lineend = "round") +#' base + geom_path(linewidth = 10, linejoin = "mitre", lineend = "butt") +#' +#' # You can use NAs to break the line. +#' df <- data.frame(x = 1:5, y = c(1, 2, NA, 4, 5)) +#' ggplot(df, aes(x, y)) + geom_point() + geom_line() +#' +#' \donttest{ +#' # Setting line type vs colour/size +#' # Line type needs to be applied to a line as a whole, so it can +#' # not be used with colour or size that vary across a line +#' x <- seq(0.01, .99, length.out = 100) +#' df <- data.frame( +#' x = rep(x, 2), +#' y = c(qlogis(x), 2 * qlogis(x)), +#' group = rep(c("a","b"), +#' each = 100) +#' ) +#' p <- ggplot(df, aes(x=x, y=y, group=group)) +#' # These work +#' p + geom_line(linetype = 2) +#' p + geom_line(aes(colour = group), linetype = 2) +#' p + geom_line(aes(colour = x)) +#' # But this doesn't +#' should_stop(p + geom_line(aes(colour = x), linetype=2)) +#' } +geom_path <- make_constructor(GeomPath) + +#' @export +#' @rdname geom_path +geom_line <- make_constructor(GeomLine, orientation = NA) + +#' @param direction direction of stairs: 'vh' for vertical then horizontal, +#' 'hv' for horizontal then vertical, or 'mid' for step half-way between +#' adjacent x-values. +#' @export +#' @rdname geom_path +geom_step <- make_constructor(GeomStep, orientation = NA) + +# Trim false values from left and right: keep all values from +# first TRUE to last TRUE +keep_mid_true <- function(x) { + first <- match(TRUE, x) - 1 + if (is.na(first)) { + return(rep(FALSE, length(x))) + } + + last <- length(x) - match(TRUE, rev(x)) + 1 + c( + rep(FALSE, first), + rep(TRUE, last - first), + rep(FALSE, length(x) - last) + ) +} + #' Calculate stairsteps for `geom_step()` #' Used by `GeomStep()` #' diff --git a/R/geom-point.R b/R/geom-point.R index 47f3fc6fc2..d23e4a410c 100644 --- a/R/geom-point.R +++ b/R/geom-point.R @@ -1,3 +1,38 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomPoint <- ggproto( + "GeomPoint", Geom, + required_aes = c("x", "y"), + non_missing_aes = c("size", "shape", "colour"), + default_aes = aes( + shape = from_theme(pointshape), + colour = from_theme(ink), size = from_theme(pointsize), fill = NA, + alpha = NA, stroke = from_theme(borderwidth) + ), + + draw_panel = function(self, data, panel_params, coord, na.rm = FALSE) { + data$shape <- translate_shape_string(data$shape) + coords <- coord$transform(data, panel_params) + ggname( + "geom_point", + pointsGrob( + coords$x, coords$y, + pch = coords$shape, + gp = gg_par( + col = alpha(coords$colour, coords$alpha), + fill = fill_alpha(coords$fill, coords$alpha), + pointsize = coords$size, + stroke = coords$stroke + ) + ) + ) + }, + + draw_key = draw_key_point +) + #' Points #' #' The point geom is used to create scatterplots. The scatterplot is most @@ -113,59 +148,7 @@ #' ggplot(mtcars2, aes(wt, mpg)) + #' geom_point(na.rm = TRUE) #' } -geom_point <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomPoint, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -GeomPoint <- ggproto("GeomPoint", Geom, - required_aes = c("x", "y"), - non_missing_aes = c("size", "shape", "colour"), - default_aes = aes( - shape = from_theme(pointshape), - colour = from_theme(ink), size = from_theme(pointsize), fill = NA, - alpha = NA, stroke = from_theme(borderwidth) - ), - - draw_panel = function(self, data, panel_params, coord, na.rm = FALSE) { - data$shape <- translate_shape_string(data$shape) - coords <- coord$transform(data, panel_params) - ggname("geom_point", - pointsGrob( - coords$x, coords$y, - pch = coords$shape, - gp = gg_par( - col = alpha(coords$colour, coords$alpha), - fill = fill_alpha(coords$fill, coords$alpha), - pointsize = coords$size, - stroke = coords$stroke - ) - ) - ) - }, - - draw_key = draw_key_point -) +geom_point <- make_constructor(GeomPoint) #' Translating shape strings #' diff --git a/R/geom-pointrange.R b/R/geom-pointrange.R index 1943bb4f4c..bddb3dc423 100644 --- a/R/geom-pointrange.R +++ b/R/geom-pointrange.R @@ -1,30 +1,3 @@ -#' @export -#' @rdname geom_linerange -geom_pointrange <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - fatten = deprecated(), - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomPointrange, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - fatten = fatten, - na.rm = na.rm, - orientation = orientation, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -77,3 +50,10 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, ) } ) + +#' @export +#' @rdname geom_linerange +geom_pointrange <- make_constructor( + GeomPointrange, + orientation = NA, fatten = deprecated() +) diff --git a/R/geom-polygon.R b/R/geom-polygon.R index a97d3c2194..0b84ea1043 100644 --- a/R/geom-polygon.R +++ b/R/geom-polygon.R @@ -1,106 +1,5 @@ -#' Polygons -#' -#' Polygons are very similar to paths (as drawn by [geom_path()]) -#' except that the start and end points are connected and the inside is -#' coloured by `fill`. The `group` aesthetic determines which cases -#' are connected together into a polygon. From R 3.6 and onwards it is possible -#' to draw polygons with holes by providing a subgroup aesthetic that -#' differentiates the outer ring points from those describing holes in the -#' polygon. -#' -#' @eval rd_aesthetics("geom", "polygon") -#' @seealso -#' [geom_path()] for an unfilled polygon, -#' [geom_ribbon()] for a polygon anchored on the x-axis -#' @export -#' @inheritParams layer -#' @inheritParams geom_point -#' @param rule Either `"evenodd"` or `"winding"`. If polygons with holes are -#' being drawn (using the `subgroup` aesthetic) this argument defines how the -#' hole coordinates are interpreted. See the examples in [grid::pathGrob()] for -#' an explanation. -#' @examples -#' # When using geom_polygon, you will typically need two data frames: -#' # one contains the coordinates of each polygon (positions), and the -#' # other the values associated with each polygon (values). An id -#' # variable links the two together -#' -#' ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3")) -#' -#' values <- data.frame( -#' id = ids, -#' value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5) -#' ) -#' -#' positions <- data.frame( -#' id = rep(ids, each = 4), -#' x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3, -#' 0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3), -#' y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5, -#' 2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2) -#' ) -#' -#' # Currently we need to manually merge the two together -#' datapoly <- merge(values, positions, by = c("id")) -#' -#' p <- ggplot(datapoly, aes(x = x, y = y)) + -#' geom_polygon(aes(fill = value, group = id)) -#' p -#' -#' # Which seems like a lot of work, but then it's easy to add on -#' # other features in this coordinate system, e.g.: -#' -#' set.seed(1) -#' stream <- data.frame( -#' x = cumsum(runif(50, max = 0.1)), -#' y = cumsum(runif(50,max = 0.1)) -#' ) -#' -#' p + geom_line(data = stream, colour = "grey30", linewidth = 5) -#' -#' # And if the positions are in longitude and latitude, you can use -#' # coord_map to produce different map projections. -#' -#' if (packageVersion("grid") >= "3.6") { -#' # As of R version 3.6 geom_polygon() supports polygons with holes -#' # Use the subgroup aesthetic to differentiate holes from the main polygon -#' -#' holes <- do.call(rbind, lapply(split(datapoly, datapoly$id), function(df) { -#' df$x <- df$x + 0.5 * (mean(df$x) - df$x) -#' df$y <- df$y + 0.5 * (mean(df$y) - df$y) -#' df -#' })) -#' datapoly$subid <- 1L -#' holes$subid <- 2L -#' datapoly <- rbind(datapoly, holes) -#' -#' p <- ggplot(datapoly, aes(x = x, y = y)) + -#' geom_polygon(aes(fill = value, group = id, subgroup = subid)) -#' p -#' } -#' -geom_polygon <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - rule = "evenodd", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomPolygon, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - rule = rule, - ... - ) - ) -} +#' @include make-constructor.R +NULL #' @rdname ggplot2-ggproto #' @format NULL @@ -194,6 +93,91 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, rename_size = TRUE ) +#' Polygons +#' +#' Polygons are very similar to paths (as drawn by [geom_path()]) +#' except that the start and end points are connected and the inside is +#' coloured by `fill`. The `group` aesthetic determines which cases +#' are connected together into a polygon. From R 3.6 and onwards it is possible +#' to draw polygons with holes by providing a subgroup aesthetic that +#' differentiates the outer ring points from those describing holes in the +#' polygon. +#' +#' @eval rd_aesthetics("geom", "polygon") +#' @seealso +#' [geom_path()] for an unfilled polygon, +#' [geom_ribbon()] for a polygon anchored on the x-axis +#' @export +#' @inheritParams layer +#' @inheritParams geom_point +#' @param lineend Line end style (round, butt, square). +#' @param linejoin Line join style (round, mitre, bevel). +#' @param linemitre Line mitre limit (number greater than 1). +#' @param rule Either `"evenodd"` or `"winding"`. If polygons with holes are +#' being drawn (using the `subgroup` aesthetic) this argument defines how the +#' hole coordinates are interpreted. See the examples in [grid::pathGrob()] for +#' an explanation. +#' @examples +#' # When using geom_polygon, you will typically need two data frames: +#' # one contains the coordinates of each polygon (positions), and the +#' # other the values associated with each polygon (values). An id +#' # variable links the two together +#' +#' ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3")) +#' +#' values <- data.frame( +#' id = ids, +#' value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5) +#' ) +#' +#' positions <- data.frame( +#' id = rep(ids, each = 4), +#' x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3, +#' 0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3), +#' y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5, +#' 2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2) +#' ) +#' +#' # Currently we need to manually merge the two together +#' datapoly <- merge(values, positions, by = c("id")) +#' +#' p <- ggplot(datapoly, aes(x = x, y = y)) + +#' geom_polygon(aes(fill = value, group = id)) +#' p +#' +#' # Which seems like a lot of work, but then it's easy to add on +#' # other features in this coordinate system, e.g.: +#' +#' set.seed(1) +#' stream <- data.frame( +#' x = cumsum(runif(50, max = 0.1)), +#' y = cumsum(runif(50,max = 0.1)) +#' ) +#' +#' p + geom_line(data = stream, colour = "grey30", linewidth = 5) +#' +#' # And if the positions are in longitude and latitude, you can use +#' # coord_map to produce different map projections. +#' +#' if (packageVersion("grid") >= "3.6") { +#' # As of R version 3.6 geom_polygon() supports polygons with holes +#' # Use the subgroup aesthetic to differentiate holes from the main polygon +#' +#' holes <- do.call(rbind, lapply(split(datapoly, datapoly$id), function(df) { +#' df$x <- df$x + 0.5 * (mean(df$x) - df$x) +#' df$y <- df$y + 0.5 * (mean(df$y) - df$y) +#' df +#' })) +#' datapoly$subid <- 1L +#' holes$subid <- 2L +#' datapoly <- rbind(datapoly, holes) +#' +#' p <- ggplot(datapoly, aes(x = x, y = y)) + +#' geom_polygon(aes(fill = value, group = id, subgroup = subid)) +#' p +#' } +geom_polygon <- make_constructor(GeomPolygon) + # Assigning pathGrob in .onLoad ensures that packages that subclass GeomPolygon # do not install with error `possible error in 'pathGrob(munched$x, munched$y, ': # unused argument (pathId = munched$group)` despite the fact that this is correct diff --git a/R/geom-quantile.R b/R/geom-quantile.R index 732ab62f8a..bd32cc93a8 100644 --- a/R/geom-quantile.R +++ b/R/geom-quantile.R @@ -1,3 +1,16 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-path.R +GeomQuantile <- ggproto( + "GeomQuantile", GeomPath, + default_aes = defaults( + aes(weight = 1, colour = from_theme(accent)), + GeomPath$default_aes + ) +) + #' Quantile regression #' #' This fits a quantile regression to the data and draws the fitted quantiles @@ -31,42 +44,4 @@ #' #' # Set aesthetics to fixed value #' m + geom_quantile(colour = "red", linewidth = 2, alpha = 0.5) -geom_quantile <- function(mapping = NULL, data = NULL, - stat = "quantile", position = "identity", - ..., - lineend = "butt", - linejoin = "round", - linemitre = 10, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomQuantile, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - lineend = lineend, - linejoin = linejoin, - linemitre = linemitre, - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @include geom-path.R -GeomQuantile <- ggproto("GeomQuantile", GeomPath, - default_aes = defaults( - aes(weight = 1, colour = from_theme(accent)), - GeomPath$default_aes - ) -) +geom_quantile <- make_constructor(GeomQuantile, stat = "quantile") diff --git a/R/geom-raster.R b/R/geom-raster.R index 94b1775373..f0e7ff1c2c 100644 --- a/R/geom-raster.R +++ b/R/geom-raster.R @@ -1,44 +1,6 @@ #' @include geom-.R NULL -#' @export -#' @rdname geom_tile -#' @param hjust,vjust horizontal and vertical justification of the grob. Each -#' justification value should be a number between 0 and 1. Defaults to 0.5 -#' for both, centering each pixel over its data location. -#' @param interpolate If `TRUE` interpolate linearly, if `FALSE` -#' (the default) don't interpolate. -geom_raster <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - hjust = 0.5, - vjust = 0.5, - interpolate = FALSE, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) -{ - check_number_decimal(hjust) - check_number_decimal(vjust) - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomRaster, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - hjust = hjust, - vjust = vjust, - interpolate = interpolate, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -126,3 +88,18 @@ GeomRaster <- ggproto("GeomRaster", Geom, }, draw_key = draw_key_rect ) + +#' @export +#' @rdname geom_tile +#' @param hjust,vjust horizontal and vertical justification of the grob. Each +#' justification value should be a number between 0 and 1. Defaults to 0.5 +#' for both, centering each pixel over its data location. +#' @param interpolate If `TRUE` interpolate linearly, if `FALSE` +#' (the default) don't interpolate. +geom_raster <- make_constructor( + GeomRaster, + checks = exprs( + check_number_decimal(hjust), + check_number_decimal(vjust) + ) +) diff --git a/R/geom-rect.R b/R/geom-rect.R index 1765a2506a..d6b850a7a8 100644 --- a/R/geom-rect.R +++ b/R/geom-rect.R @@ -1,28 +1,3 @@ -#' @export -#' @rdname geom_tile -geom_rect <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - linejoin = "mitre", - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomRect, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - linejoin = linejoin, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -109,6 +84,10 @@ GeomRect <- ggproto("GeomRect", Geom, rename_size = TRUE ) +#' @export +#' @rdname geom_tile +geom_rect <- make_constructor(GeomRect) + resolve_rect <- function(min = NULL, max = NULL, center = NULL, length = NULL, fun, type) { absent <- c(is.null(min), is.null(max), is.null(center), is.null(length)) diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R index 746684afbe..6d5166ac51 100644 --- a/R/geom-ribbon.R +++ b/R/geom-ribbon.R @@ -1,96 +1,3 @@ -#' Ribbons and area plots -#' -#' For each x value, `geom_ribbon()` displays a y interval defined -#' by `ymin` and `ymax`. `geom_area()` is a special case of -#' `geom_ribbon()`, where the `ymin` is fixed to 0 and `y` is used instead -#' of `ymax`. -#' -#' An area plot is the continuous analogue of a stacked bar chart (see -#' [geom_bar()]), and can be used to show how composition of the -#' whole varies over the range of x. Choosing the order in which different -#' components is stacked is very important, as it becomes increasing hard to -#' see the individual pattern as you move up the stack. See -#' [position_stack()] for the details of stacking algorithm. To facilitate -#' stacking, the default `stat = "align"` interpolates groups to a common set -#' of x-coordinates. To turn off this interpolation, `stat = "identity"` can -#' be used instead. -#' -#' @eval rd_orientation() -#' -#' @eval rd_aesthetics("geom", "ribbon") -#' @seealso -#' [geom_bar()] for discrete intervals (bars), -#' [geom_linerange()] for discrete intervals (lines), -#' [geom_polygon()] for general polygons -#' @inheritParams layer -#' @inheritParams geom_bar -#' @param outline.type Type of the outline of the area; `"both"` draws both the -#' upper and lower lines, `"upper"`/`"lower"` draws the respective lines only. -#' `"full"` draws a closed polygon around the area. -#' @export -#' @examples -#' # Generate data -#' huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) -#' h <- ggplot(huron, aes(year)) -#' -#' h + geom_ribbon(aes(ymin=0, ymax=level)) -#' h + geom_area(aes(y = level)) -#' -#' # Orientation cannot be deduced by mapping, so must be given explicitly for -#' # flipped orientation -#' h + geom_area(aes(x = level, y = year), orientation = "y") -#' -#' # Add aesthetic mappings -#' h + -#' geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + -#' geom_line(aes(y = level)) -#' -#' # The underlying stat_align() takes care of unaligned data points -#' df <- data.frame( -#' g = c("a", "a", "a", "b", "b", "b"), -#' x = c(1, 3, 5, 2, 4, 6), -#' y = c(2, 5, 1, 3, 6, 7) -#' ) -#' a <- ggplot(df, aes(x, y, fill = g)) + -#' geom_area() -#' -#' # Two groups have points on different X values. -#' a + geom_point(size = 8) + facet_grid(g ~ .) -#' -#' # stat_align() interpolates and aligns the value so that the areas can stack -#' # properly. -#' a + geom_point(stat = "align", position = "stack", size = 8) -#' -#' # To turn off the alignment, the stat can be set to "identity" -#' ggplot(df, aes(x, y, fill = g)) + -#' geom_area(stat = "identity") -geom_ribbon <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE, - outline.type = "both") { - outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomRibbon, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - orientation = orientation, - outline.type = outline.type, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -289,31 +196,6 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, rename_size = TRUE ) -#' @rdname geom_ribbon -#' @export -geom_area <- function(mapping = NULL, data = NULL, stat = "align", - position = "stack", na.rm = FALSE, orientation = NA, - show.legend = NA, inherit.aes = TRUE, ..., - outline.type = "upper") { - outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) - - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomArea, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - orientation = orientation, - outline.type = outline.type, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -342,3 +224,88 @@ GeomArea <- ggproto("GeomArea", GeomRibbon, flip_data(data, params$flipped_aes) } ) + +#' Ribbons and area plots +#' +#' For each x value, `geom_ribbon()` displays a y interval defined +#' by `ymin` and `ymax`. `geom_area()` is a special case of +#' `geom_ribbon()`, where the `ymin` is fixed to 0 and `y` is used instead +#' of `ymax`. +#' +#' An area plot is the continuous analogue of a stacked bar chart (see +#' [geom_bar()]), and can be used to show how composition of the +#' whole varies over the range of x. Choosing the order in which different +#' components is stacked is very important, as it becomes increasing hard to +#' see the individual pattern as you move up the stack. See +#' [position_stack()] for the details of stacking algorithm. To facilitate +#' stacking, the default `stat = "align"` interpolates groups to a common set +#' of x-coordinates. To turn off this interpolation, `stat = "identity"` can +#' be used instead. +#' +#' @eval rd_orientation() +#' +#' @eval rd_aesthetics("geom", "ribbon") +#' @seealso +#' [geom_bar()] for discrete intervals (bars), +#' [geom_linerange()] for discrete intervals (lines), +#' [geom_polygon()] for general polygons +#' @inheritParams layer +#' @inheritParams geom_bar +#' @param linemitre Line mitre limit (number greater than 1). +#' @param outline.type Type of the outline of the area; `"both"` draws both the +#' upper and lower lines, `"upper"`/`"lower"` draws the respective lines only. +#' `"full"` draws a closed polygon around the area. +#' @export +#' @examples +#' # Generate data +#' huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron)) +#' h <- ggplot(huron, aes(year)) +#' +#' h + geom_ribbon(aes(ymin=0, ymax=level)) +#' h + geom_area(aes(y = level)) +#' +#' # Orientation cannot be deduced by mapping, so must be given explicitly for +#' # flipped orientation +#' h + geom_area(aes(x = level, y = year), orientation = "y") +#' +#' # Add aesthetic mappings +#' h + +#' geom_ribbon(aes(ymin = level - 1, ymax = level + 1), fill = "grey70") + +#' geom_line(aes(y = level)) +#' +#' # The underlying stat_align() takes care of unaligned data points +#' df <- data.frame( +#' g = c("a", "a", "a", "b", "b", "b"), +#' x = c(1, 3, 5, 2, 4, 6), +#' y = c(2, 5, 1, 3, 6, 7) +#' ) +#' a <- ggplot(df, aes(x, y, fill = g)) + +#' geom_area() +#' +#' # Two groups have points on different X values. +#' a + geom_point(size = 8) + facet_grid(g ~ .) +#' +#' # stat_align() interpolates and aligns the value so that the areas can stack +#' # properly. +#' a + geom_point(stat = "align", position = "stack", size = 8) +#' +#' # To turn off the alignment, the stat can be set to "identity" +#' ggplot(df, aes(x, y, fill = g)) + +#' geom_area(stat = "identity") +#' +geom_ribbon <- make_constructor( + GeomRibbon, orientation = NA, + checks = exprs( + outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) + ) +) + +#' @rdname geom_ribbon +#' @export +geom_area <- make_constructor( + GeomArea, stat = "align", position = "stack", + orientation = NA, outline.type = "upper", + checks = exprs( + outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) + ) +) diff --git a/R/geom-rug.R b/R/geom-rug.R index 8992f1069d..12ceb195ec 100644 --- a/R/geom-rug.R +++ b/R/geom-rug.R @@ -1,86 +1,3 @@ -#' Rug plots in the margins -#' -#' A rug plot is a compact visualisation designed to supplement a 2d display -#' with the two 1d marginal distributions. Rug plots display individual -#' cases so are best used with smaller datasets. -#' -#' By default, the rug lines are drawn with a length that corresponds to 3% -#' of the total plot size. Since the default scale expansion of for continuous -#' variables is 5% at both ends of the scale, the rug will not overlap with -#' any data points under the default settings. -#' -#' @eval rd_aesthetics("geom", "rug") -#' @inheritParams layer -#' @inheritParams geom_point -#' @param sides A string that controls which sides of the plot the rugs appear on. -#' It can be set to a string containing any of `"trbl"`, for top, right, -#' bottom, and left. -#' @param outside logical that controls whether to move the rug tassels outside of the plot area. Default is off (FALSE). You will also need to use `coord_cartesian(clip = "off")`. When set to TRUE, also consider changing the sides argument to "tr". See examples. -#' @param length A [grid::unit()] object that sets the length of the rug lines. Use scale expansion to avoid overplotting of data. -#' @export -#' @examples -#' p <- ggplot(mtcars, aes(wt, mpg)) + -#' geom_point() -#' p -#' p + geom_rug() -#' p + geom_rug(sides="b") # Rug on bottom only -#' p + geom_rug(sides="trbl") # All four sides -#' -#' # Use jittering to avoid overplotting for smaller datasets -#' ggplot(mpg, aes(displ, cty)) + -#' geom_point() + -#' geom_rug() -#' -#' ggplot(mpg, aes(displ, cty)) + -#' geom_jitter() + -#' geom_rug(alpha = 1/2, position = "jitter") -#' -#' # move the rug tassels to outside the plot -#' # remember to set clip = "off". -#' p + -#' geom_rug(outside = TRUE) + -#' coord_cartesian(clip = "off") -#' -#' # set sides to top right, and then move the margins -#' p + -#' geom_rug(outside = TRUE, sides = "tr") + -#' coord_cartesian(clip = "off") + -#' theme(plot.margin = margin_auto(1, unit = "cm")) -#' -#' # increase the line length and -#' # expand axis to avoid overplotting -#' p + -#' geom_rug(length = unit(0.05, "npc")) + -#' scale_y_continuous(expand = c(0.1, 0.1)) -#' -geom_rug <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - outside = FALSE, - sides = "bl", - length = unit(0.03, "npc"), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomRug, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - outside = outside, - sides = sides, - length = length, - na.rm = na.rm, - ... - ) - ) -} - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -208,3 +125,60 @@ GeomRug <- ggproto("GeomRug", Geom, data } ) + +#' Rug plots in the margins +#' +#' A rug plot is a compact visualisation designed to supplement a 2d display +#' with the two 1d marginal distributions. Rug plots display individual +#' cases so are best used with smaller datasets. +#' +#' By default, the rug lines are drawn with a length that corresponds to 3% +#' of the total plot size. Since the default scale expansion of for continuous +#' variables is 5% at both ends of the scale, the rug will not overlap with +#' any data points under the default settings. +#' +#' @eval rd_aesthetics("geom", "rug") +#' @inheritParams layer +#' @inheritParams geom_point +#' @param sides A string that controls which sides of the plot the rugs appear on. +#' It can be set to a string containing any of `"trbl"`, for top, right, +#' bottom, and left. +#' @param outside logical that controls whether to move the rug tassels outside of the plot area. Default is off (FALSE). You will also need to use `coord_cartesian(clip = "off")`. When set to TRUE, also consider changing the sides argument to "tr". See examples. +#' @param length A [grid::unit()] object that sets the length of the rug lines. Use scale expansion to avoid overplotting of data. +#' @param lineend Line end style (round, butt, square). +#' @export +#' @examples +#' p <- ggplot(mtcars, aes(wt, mpg)) + +#' geom_point() +#' p +#' p + geom_rug() +#' p + geom_rug(sides="b") # Rug on bottom only +#' p + geom_rug(sides="trbl") # All four sides +#' +#' # Use jittering to avoid overplotting for smaller datasets +#' ggplot(mpg, aes(displ, cty)) + +#' geom_point() + +#' geom_rug() +#' +#' ggplot(mpg, aes(displ, cty)) + +#' geom_jitter() + +#' geom_rug(alpha = 1/2, position = "jitter") +#' +#' # move the rug tassels to outside the plot +#' # remember to set clip = "off". +#' p + +#' geom_rug(outside = TRUE) + +#' coord_cartesian(clip = "off") +#' +#' # set sides to top right, and then move the margins +#' p + +#' geom_rug(outside = TRUE, sides = "tr") + +#' coord_cartesian(clip = "off") + +#' theme(plot.margin = margin_auto(1, unit = "cm")) +#' +#' # increase the line length and +#' # expand axis to avoid overplotting +#' p + +#' geom_rug(length = unit(0.05, "npc")) + +#' scale_y_continuous(expand = c(0.1, 0.1)) +geom_rug <- make_constructor(GeomRug) diff --git a/R/geom-segment.R b/R/geom-segment.R index 51de135b53..c36be39e46 100644 --- a/R/geom-segment.R +++ b/R/geom-segment.R @@ -1,3 +1,64 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomSegment <- ggproto( + "GeomSegment", Geom, + required_aes = c("x", "y", "xend|yend"), + non_missing_aes = c("linetype", "linewidth"), + + default_aes = aes( + colour = from_theme(ink), + linewidth = from_theme(linewidth), + linetype = from_theme(linetype), + alpha = NA + ), + + draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL, + lineend = "butt", linejoin = "round", na.rm = FALSE) { + data$xend <- data$xend %||% data$x + data$yend <- data$yend %||% data$y + data <- fix_linewidth(data, snake_class(self)) + data <- remove_missing(data, na.rm = na.rm, + c("x", "y", "xend", "yend", "linetype", "linewidth"), + name = "geom_segment" + ) + + if (empty(data)) return(zeroGrob()) + + if (coord$is_linear()) { + coord <- coord$transform(data, panel_params) + arrow.fill <- arrow.fill %||% coord$colour + return(segmentsGrob(coord$x, coord$y, coord$xend, coord$yend, + default.units = "native", + gp = gg_par( + col = alpha(coord$colour, coord$alpha), + fill = alpha(arrow.fill, coord$alpha), + lwd = coord$linewidth, + lty = coord$linetype, + lineend = lineend, + linejoin = linejoin + ), + arrow = arrow + )) + } + + data$group <- seq_len(nrow(data)) + starts <- subset(data, select = c(-xend, -yend)) + ends <- rename(subset(data, select = c(-x, -y)), c("xend" = "x", "yend" = "y")) + + pieces <- vec_rbind0(starts, ends) + pieces <- pieces[order(pieces$group),] + + GeomPath$draw_panel(pieces, panel_params, coord, arrow = arrow, + lineend = lineend) + }, + + draw_key = draw_key_path, + + rename_size = TRUE +) + #' Line segments and curves #' #' `geom_segment()` draws a straight line between points (x, y) and @@ -68,91 +129,4 @@ #' #' ggplot(counts, aes(x, Freq)) + #' geom_segment(aes(xend = x, yend = 0), linewidth = 10, lineend = "butt") -geom_segment <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - arrow = NULL, - arrow.fill = NULL, - lineend = "butt", - linejoin = "round", - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomSegment, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - arrow = arrow, - arrow.fill = arrow.fill, - lineend = lineend, - linejoin = linejoin, - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -GeomSegment <- ggproto("GeomSegment", Geom, - required_aes = c("x", "y", "xend|yend"), - non_missing_aes = c("linetype", "linewidth"), - - default_aes = aes( - colour = from_theme(ink), - linewidth = from_theme(linewidth), - linetype = from_theme(linetype), - alpha = NA - ), - - draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL, - lineend = "butt", linejoin = "round", na.rm = FALSE) { - data$xend <- data$xend %||% data$x - data$yend <- data$yend %||% data$y - data <- fix_linewidth(data, snake_class(self)) - data <- remove_missing(data, na.rm = na.rm, - c("x", "y", "xend", "yend", "linetype", "linewidth"), - name = "geom_segment" - ) - - if (empty(data)) return(zeroGrob()) - - if (coord$is_linear()) { - coord <- coord$transform(data, panel_params) - arrow.fill <- arrow.fill %||% coord$colour - return(segmentsGrob(coord$x, coord$y, coord$xend, coord$yend, - default.units = "native", - gp = gg_par( - col = alpha(coord$colour, coord$alpha), - fill = alpha(arrow.fill, coord$alpha), - lwd = coord$linewidth, - lty = coord$linetype, - lineend = lineend, - linejoin = linejoin - ), - arrow = arrow - )) - } - - data$group <- seq_len(nrow(data)) - starts <- subset(data, select = c(-xend, -yend)) - ends <- rename(subset(data, select = c(-x, -y)), c("xend" = "x", "yend" = "y")) - - pieces <- vec_rbind0(starts, ends) - pieces <- pieces[order(pieces$group),] - - GeomPath$draw_panel(pieces, panel_params, coord, arrow = arrow, - lineend = lineend) - }, - - draw_key = draw_key_path, - - rename_size = TRUE -) +geom_segment <- make_constructor(GeomSegment) diff --git a/R/geom-smooth.R b/R/geom-smooth.R index 08e1099df0..33ed5c5d80 100644 --- a/R/geom-smooth.R +++ b/R/geom-smooth.R @@ -1,3 +1,65 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomSmooth <- ggproto( + "GeomSmooth", Geom, + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE, ambiguous = TRUE) + params$se <- params$se %||% + if (params$flipped_aes) { + all(c("xmin", "xmax") %in% names(data)) + } else { + all(c("ymin", "ymax") %in% names(data)) + } + + params + }, + + extra_params = c("na.rm", "orientation"), + + setup_data = function(data, params) { + GeomLine$setup_data(data, params) + }, + + # The `se` argument is set to false here to make sure drawing the + # geom and drawing the legend is in synch. If the geom is used by a + # stat that doesn't set the `se` argument then `se` will be missing + # and the legend key won't be drawn. With `se = FALSE` here the + # ribbon won't be drawn either in that case, keeping the overall + # behavior predictable and sensible. The user will realize that they + # need to set `se = TRUE` to obtain the ribbon and the legend key. + draw_group = function(data, panel_params, coord, lineend = "butt", linejoin = "round", + linemitre = 10, se = FALSE, flipped_aes = FALSE) { + ribbon <- transform(data, colour = NA) + path <- transform(data, alpha = NA) + + ymin <- flipped_names(flipped_aes)$ymin + ymax <- flipped_names(flipped_aes)$ymax + has_ribbon <- se && !is.null(data[[ymax]]) && !is.null(data[[ymin]]) + + gList( + if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_params, coord, flipped_aes = flipped_aes), + GeomLine$draw_panel(path, panel_params, coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre) + ) + }, + + draw_key = draw_key_smooth, + + required_aes = c("x", "y"), + optional_aes = c("ymin", "ymax"), + + default_aes = aes( + colour = from_theme(accent), + fill = from_theme(col_mix(ink, paper, 0.6)), + linewidth = from_theme(2 * linewidth), + linetype = from_theme(linetype), + weight = 1, alpha = 0.4 + ), + + rename_size = TRUE +) + #' Smoothed conditional means #' #' Aids the eye in seeing patterns in the presence of overplotting. @@ -117,64 +179,3 @@ geom_smooth <- function(mapping = NULL, data = NULL, params = params ) } - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -GeomSmooth <- ggproto("GeomSmooth", Geom, - setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE, ambiguous = TRUE) - params$se <- params$se %||% - if (params$flipped_aes) { - all(c("xmin", "xmax") %in% names(data)) - } else { - all(c("ymin", "ymax") %in% names(data)) - } - - params - }, - - extra_params = c("na.rm", "orientation"), - - setup_data = function(data, params) { - GeomLine$setup_data(data, params) - }, - - # The `se` argument is set to false here to make sure drawing the - # geom and drawing the legend is in synch. If the geom is used by a - # stat that doesn't set the `se` argument then `se` will be missing - # and the legend key won't be drawn. With `se = FALSE` here the - # ribbon won't be drawn either in that case, keeping the overall - # behavior predictable and sensible. The user will realize that they - # need to set `se = TRUE` to obtain the ribbon and the legend key. - draw_group = function(data, panel_params, coord, lineend = "butt", linejoin = "round", - linemitre = 10, se = FALSE, flipped_aes = FALSE) { - ribbon <- transform(data, colour = NA) - path <- transform(data, alpha = NA) - - ymin <- flipped_names(flipped_aes)$ymin - ymax <- flipped_names(flipped_aes)$ymax - has_ribbon <- se && !is.null(data[[ymax]]) && !is.null(data[[ymin]]) - - gList( - if (has_ribbon) GeomRibbon$draw_group(ribbon, panel_params, coord, flipped_aes = flipped_aes), - GeomLine$draw_panel(path, panel_params, coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre) - ) - }, - - draw_key = draw_key_smooth, - - required_aes = c("x", "y"), - optional_aes = c("ymin", "ymax"), - - default_aes = aes( - colour = from_theme(accent), - fill = from_theme(col_mix(ink, paper, 0.6)), - linewidth = from_theme(2 * linewidth), - linetype = from_theme(linetype), - weight = 1, alpha = 0.4 - ), - - rename_size = TRUE -) diff --git a/R/geom-spoke.R b/R/geom-spoke.R index 032267b765..26d6422390 100644 --- a/R/geom-spoke.R +++ b/R/geom-spoke.R @@ -1,3 +1,21 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomSpoke <- ggproto( + "GeomSpoke", GeomSegment, + setup_data = function(data, params) { + data$radius <- data$radius %||% params$radius + data$angle <- data$angle %||% params$angle + + transform(data, + xend = x + cos(angle) * radius, + yend = y + sin(angle) * radius + ) + }, + required_aes = c("x", "y", "angle", "radius") +) + #' Line segments parameterised by location, direction and distance #' #' This is a polar parameterisation of [geom_segment()]. It is @@ -22,26 +40,7 @@ #' ggplot(df, aes(x, y)) + #' geom_point() + #' geom_spoke(aes(angle = angle, radius = speed)) -geom_spoke <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - geom = GeomSpoke, - stat = stat, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} +geom_spoke <- make_constructor(GeomSpoke) #' @export #' @rdname geom_spoke @@ -50,20 +49,3 @@ stat_spoke <- function(...) { deprecate_warn0("2.0.0", "stat_spoke()", "geom_spoke()") geom_spoke(...) } - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -GeomSpoke <- ggproto("GeomSpoke", GeomSegment, - setup_data = function(data, params) { - data$radius <- data$radius %||% params$radius - data$angle <- data$angle %||% params$angle - - transform(data, - xend = x + cos(angle) * radius, - yend = y + sin(angle) * radius - ) - }, - required_aes = c("x", "y", "angle", "radius") -) diff --git a/R/geom-tile.R b/R/geom-tile.R index 04ff0b71c2..7fb725b327 100644 --- a/R/geom-tile.R +++ b/R/geom-tile.R @@ -1,3 +1,50 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-rect.R +GeomTile <- ggproto( + "GeomTile", GeomRect, + extra_params = c("na.rm"), + + setup_data = function(self, data, params) { + + data <- compute_data_size( + data, params$width, + default = self$default_aes$width, + panels = "by", target = "width", + zero = FALSE, discrete = TRUE + ) + data <- compute_data_size( + data, params$height, + default = self$default_aes$height, + panels = "by", target = "height", + zero = FALSE, discrete = TRUE + ) + transform(data, + xmin = x - width / 2, xmax = x + width / 2, width = NULL, + ymin = y - height / 2, ymax = y + height / 2, height = NULL + ) + }, + + default_aes = aes( + fill = from_theme(col_mix(ink, paper, 0.2)), + colour = NA, + linewidth = from_theme(0.4 * borderwidth), + linetype = from_theme(bordertype), + alpha = NA, width = 1, height = 1 + ), + + required_aes = c("x", "y"), + + # These aes columns are created by setup_data(). They need to be listed here so + # that GeomRect$handle_na() properly removes any bars that fall outside the defined + # limits, not just those for which x and y are outside the limits + non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), + + draw_key = draw_key_polygon +) + #' Rectangles #' #' `geom_rect()` and `geom_tile()` do the same thing, but are @@ -78,71 +125,4 @@ #' position = "identity" #' ) #' } -geom_tile <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - linejoin = "mitre", - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomTile, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - linejoin = linejoin, - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -#' @include geom-rect.R -GeomTile <- ggproto("GeomTile", GeomRect, - extra_params = c("na.rm"), - - setup_data = function(self, data, params) { - - data <- compute_data_size( - data, params$width, - default = self$default_aes$width, - panels = "by", target = "width", - zero = FALSE, discrete = TRUE - ) - data <- compute_data_size( - data, params$height, - default = self$default_aes$height, - panels = "by", target = "height", - zero = FALSE, discrete = TRUE - ) - transform(data, - xmin = x - width / 2, xmax = x + width / 2, width = NULL, - ymin = y - height / 2, ymax = y + height / 2, height = NULL - ) - }, - - default_aes = aes( - fill = from_theme(col_mix(ink, paper, 0.2)), - colour = NA, - linewidth = from_theme(0.4 * borderwidth), - linetype = from_theme(bordertype), - alpha = NA, width = 1, height = 1 - ), - - required_aes = c("x", "y"), - - # These aes columns are created by setup_data(). They need to be listed here so - # that GeomRect$handle_na() properly removes any bars that fall outside the defined - # limits, not just those for which x and y are outside the limits - non_missing_aes = c("xmin", "xmax", "ymin", "ymax"), - - draw_key = draw_key_polygon -) +geom_tile <- make_constructor(GeomTile) diff --git a/R/make-constructor.R b/R/make-constructor.R new file mode 100644 index 0000000000..8dc4c5f454 --- /dev/null +++ b/R/make-constructor.R @@ -0,0 +1,232 @@ +#' @include layer.R +#' @include scale-type.R +NULL + +#' Produce boilerplate constructors +#' +#' The `make_constructor()` functions sets up a user-facing constructor for +#' ggproto classes. Currently, `make_constructor()` is implemented for +#' `Geom` classes. +#' +#' @param x An object to setup a constructor for. +#' @param ... Name-value pairs to use as additional arguments in the +#' constructor. For layers, these are passed on to [`layer(params)`][layer()]. +#' @param checks A list of calls to be evaluated before construction of the +#' object, such as one constructed with [`exprs()`][rlang::exprs()]. +#' @param omit A character vector of automatically retrieved argument names +#' that should not be converted to user-facing arguments. Useful for +#' internally computed variables. +#' @param env An environment to search for the object. +#' +#' @return A function +#' @export +#' @keywords internal +#' +#' @examples +#' # For testing purposes, a geom that returns grobs +#' GeomTest <- ggproto( +#' "GeomTest", Geom, +#' draw_group = function(..., grob = grid::pointsGrob()) { +#' return(grob) +#' } +#' ) +#' # Creating a constructor +#' geom_test <- make_constructor(GeomTest) +#' +#' # Note that `grob` is automatically an argument to the function +#' names(formals(geom_test)) +#' +#' # Use in a plot +#' set.seed(1234) +#' p <- ggplot(mtcars, aes(disp, mpg)) +#' p + geom_test() +#' p + geom_test(grob = grid::circleGrob()) +#' +#' # The `checks` argument can be used to evaluate arbitrary expressions in +#' # the constructor before building the layer. +#' geom_path2 <- make_constructor( +#' GeomPath, checks = rlang::exprs( +#' match.arg(lineend, c("butt", "round", "square")), +#' match.arg(linejoin, c("round", "mitre", "bevel")) +#' ) +#' ) +#' +#' # Note the inclusion of the expressions +#' print(geom_path2) +#' +#' # Argument mismatch is detected +#' try(geom_path2(linejoin = "foo")) +make_constructor <- function(x, ...) { + UseMethod("make_constructor") +} + +#' @export +#' @rdname make_constructor +make_constructor.Geom <- function(x, ..., checks = exprs(), omit = character(), + env = caller_env()) { + + # Check that we can independently find the geom + geom <- gsub("^geom_", "", snake_class(x)) + validate_subclass(geom, "Geom", env = env) + + # Split additional arguments into required and extra ones + args <- enexprs(...) + fixed_fmls_names <- c("mapping", "data", "stat", "position", "...", + "na.rm", "show.legend", "inherit.aes") + extra_args <- setdiff(names(args), fixed_fmls_names) + if ("geom" %in% extra_args) { + cli::cli_abort("{.arg geom} is a reserved argument.") + } + + # Fill in values for parameters from draw functions + known_params <- + unique(c(names(args), fixed_fmls_names, "flipped_aes", x$aesthetics(), omit)) + missing_params <- setdiff(x$parameters(), known_params) + if (length(missing_params) > 0) { + draw_args <- ggproto_formals(x$draw_panel) + if ("..." %in% names(draw_args)) { + draw_args <- ggproto_formals(x$draw_group) + } + params <- intersect(missing_params, names(draw_args)) + extra_args <- c(extra_args, params) + for (param in params) { + if (!identical(draw_args[[param]], quote(expr = ))) { + args[param] <- draw_args[param] + } + } + extra_args <- intersect(extra_args, names(args)) + missing_params <- setdiff(missing_params, names(args)) + if (length(missing_params) > 0) { + cli::cli_warn( + "In {.fn geom_{geom}}: please consider providing default values for: \\ + {missing_params}." + ) + } + } + + # Build function formals + fmls <- pairlist2( + mapping = args$mapping, + data = args$data, + stat = args$stat %||% "identity", + position = args$position %||% "identity", + `...` = missing_arg(), + !!!args[extra_args], + na.rm = args$na.rm %||% FALSE, + show.legend = args$show.legend %||% NA, + inherit.aes = args$inherit.aes %||% TRUE + ) + + # Construct call for the 'layer(params)' argument + params <- exprs(!!!syms(c("na.rm", extra_args)), .named = TRUE) + params <- call2("list2", !!!params, quote(...)) + + # Construct rest of 'layer()' call + layer_args <- syms(setdiff(fixed_fmls_names, c("...", "na.rm"))) + layer_args <- append(layer_args, list(geom = geom), after = 2) + layer_args <- exprs(!!!layer_args, params = !!params, .named = TRUE) + body <- call2("layer", !!!layer_args) + + # Prepend any checks + if (length(exprs) > 0) { + lang <- vapply(checks, is_call, logical(1)) + if (!all(lang)) { + cli::cli_abort( + "{.arg checks} must be a list of calls, such as one constructed \\ + with {.fn rlang::exprs}." + ) + } + } + body <- call2("{", !!!checks, body) + + # We encapsulate rlang::list2 + new_env <- new_environment(list(list2 = list2), env) + + new_function(fmls, body, new_env) +} + +#' @export +#' @rdname make_constructor +make_constructor.Stat <- function(x, ..., checks = exprs(), omit = character(), + env = caller_env()) { + # Check that we can independently find the stat + stat <- gsub("^stat_", "", snake_class(x)) + validate_subclass(stat, "Stat", env = env) + + # Split additional arguments into required and extra ones + args <- enexprs(...) + fixed_fmls_names <- c("mapping", "data", "geom", "position", "...", + "na.rm", "show.legend", "inherit.aes") + extra_args <- setdiff(names(args), fixed_fmls_names) + if ("stat" %in% extra_args) { + cli::cli_abort("{.arg stat} is a reversed argument.") + } + + known_params <- + unique(c(names(args), fixed_fmls_names, "flipped_aes", x$aesthetics(), omit)) + missing_params <- setdiff(x$parameters(), known_params) + + # Fill in missing parameters from the compute methods + if (length(missing_params) > 0) { + compute_args <- ggproto_formals(x$compute_panel) + if ("..." %in% names(compute_args)) { + compute_args <- ggproto_formals(x$compute_group) + } + params <- intersect(missing_params, names(compute_args)) + extra_args <- c(extra_args, params) + for (param in params) { + if (!identical(compute_args[[param]], missing_arg())) { + args[param] <- compute_args[param] + } + } + extra_args <- intersect(extra_args, names(args)) + missing_params <- setdiff(missing_params, names(args)) + if (length(missing_params) > 0) { + cli::cli_warn( + "In {.fn stat_{stat}}: please consider providing default values for: \\ + {missing_params}." + ) + } + } + + # Build function formals + fmls <- pairlist2( + mapping = args$mapping, + data = args$data, + geom = args$geom %||% cli::cli_abort("{.arg geom} is required."), + position = args$position %||% "identity", + `...` = missing_arg(), + !!!args[extra_args], + na.rm = args$na.rm %||% FALSE, + show.legend = args$show.legend %||% NA, + inherit.aes = args$inherit.aes %||% TRUE + ) + + # Construct params for the `layer(params)` argument + params <- exprs(!!!syms(c("na.rm", extra_args)), .named = TRUE) + params <- call2("list2", !!!params, quote(...)) + + # Construct rest of `layer()` call + layer_args <- syms(setdiff(fixed_fmls_names, c("...", "na.rm"))) + layer_args <- append(layer_args, list(stat = stat), after = 3) + layer_args <- exprs(!!!layer_args, params = !!params, .named = TRUE) + body <- call2("layer", !!!layer_args) + + # Prepend any checks + if (length(exprs) > 0) { + lang <- vapply(checks, is_call, logical(1)) + if (!all(lang)) { + cli::cli_abort( + "{.arg checks} must be a list of calls, such as one constructed \\ + with {.fn rlang::exprs}." + ) + } + } + body <- call2("{", !!!checks, body) + + # We encapsulate rlang::list2 + new_env <- new_environment(list(list2 = list2), env) + + new_function(fmls, body, new_env) +} + diff --git a/R/stat-align.R b/R/stat-align.R index 3187ca28c0..48d6481ade 100644 --- a/R/stat-align.R +++ b/R/stat-align.R @@ -1,33 +1,9 @@ -#' @inheritParams layer -#' @inheritParams geom_point -#' @export -#' @rdname geom_ribbon -stat_align <- function(mapping = NULL, data = NULL, - geom = "area", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatAlign, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatAlign <- ggproto("StatAlign", Stat, +StatAlign <- ggproto( + "StatAlign", Stat, extra_params = c("na.rm", "orientation"), required_aes = c("x", "y"), @@ -99,3 +75,12 @@ StatAlign <- ggproto("StatAlign", Stat, flip_data(data_aligned, flipped_aes) } ) + +#' @inheritParams layer +#' @inheritParams geom_point +#' @export +#' @rdname geom_ribbon +stat_align <- make_constructor( + StatAlign, geom = "area", + omit = c("unique_loc", "adjust") +) diff --git a/R/stat-bin.R b/R/stat-bin.R index 711b0c5ad7..9a6073eac6 100644 --- a/R/stat-bin.R +++ b/R/stat-bin.R @@ -1,99 +1,9 @@ -#' @param binwidth The width of the bins. Can be specified as a numeric value -#' or as a function that takes x after scale transformation as input and -#' returns a single numeric value. When specifying a function along with a -#' grouping structure, the function will be called once per group. -#' The default is to use the number of bins in `bins`, -#' covering the range of the data. You should always override -#' this value, exploring multiple widths to find the best to illustrate the -#' stories in your data. -#' -#' The bin width of a date variable is the number of days in each time; the -#' bin width of a time variable is the number of seconds. -#' @param bins Number of bins. Overridden by `binwidth`. Defaults to 30. -#' @param center,boundary bin position specifiers. Only one, `center` or -#' `boundary`, may be specified for a single plot. `center` specifies the -#' center of one of the bins. `boundary` specifies the boundary between two -#' bins. Note that if either is above or below the range of the data, things -#' will be shifted by the appropriate integer multiple of `binwidth`. -#' For example, to center on integers use `binwidth = 1` and `center = 0`, even -#' if `0` is outside the range of the data. Alternatively, this same alignment -#' can be specified with `binwidth = 1` and `boundary = 0.5`, even if `0.5` is -#' outside the range of the data. -#' @param breaks Alternatively, you can supply a numeric vector giving -#' the bin boundaries. Overrides `binwidth`, `bins`, `center`, -#' and `boundary`. Can also be a function that takes group-wise values as input and returns bin boundaries. -#' @param closed One of `"right"` or `"left"` indicating whether right -#' or left edges of bins are included in the bin. -#' @param pad If `TRUE`, adds empty bins at either end of x. This ensures -#' frequency polygons touch 0. Defaults to `FALSE`. -#' @param drop Treatment of zero count bins. If `"all"` (default), such -#' bins are kept as-is. If `"none"`, all zero count bins are filtered out. -#' If `"inner"` only zero count bins at the flanks are filtered out, but not -#' in the middle. `TRUE` is shorthand for `"all"` and `FALSE` is shorthand -#' for `"none"`. -#' @eval rd_computed_vars( -#' count = "number of points in bin.", -#' density = "density of points in bin, scaled to integrate to 1.", -#' ncount = "count, scaled to a maximum of 1.", -#' ndensity = "density, scaled to a maximum of 1.", -#' width = "widths of bins." -#' ) -#' -#' @section Dropped variables: -#' \describe{ -#' \item{`weight`}{After binning, weights of individual data points (if supplied) are no longer available.} -#' } -#' -#' @seealso [stat_count()], which counts the number of cases at each x -#' position, without binning. It is suitable for both discrete and continuous -#' x data, whereas `stat_bin()` is suitable only for continuous x data. -#' @export -#' @rdname geom_histogram -stat_bin <- function(mapping = NULL, data = NULL, - geom = "bar", position = "stack", - ..., - binwidth = NULL, - bins = NULL, - center = NULL, - boundary = NULL, - breaks = NULL, - closed = c("right", "left"), - pad = FALSE, - na.rm = FALSE, - drop = "all", - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - - layer( - data = data, - mapping = mapping, - stat = StatBin, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - binwidth = binwidth, - bins = bins, - center = center, - boundary = boundary, - breaks = breaks, - closed = closed, - pad = pad, - na.rm = na.rm, - orientation = orientation, - drop = drop, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatBin <- ggproto("StatBin", Stat, +StatBin <- ggproto( + "StatBin", Stat, setup_params = function(self, data, params) { params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE) @@ -127,15 +37,12 @@ StatBin <- ggproto("StatBin", Stat, params }, - extra_params = c("na.rm", "orientation"), + extra_params = c("na.rm", "orientation", "origin", "right"), compute_group = function(data, scales, binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, closed = c("right", "left"), pad = FALSE, - breaks = NULL, flipped_aes = FALSE, drop = "all", - # The following arguments are not used, but must - # be listed so parameters are computed correctly - origin = NULL, right = NULL) { + breaks = NULL, flipped_aes = FALSE, drop = "all") { x <- flipped_names(flipped_aes)$x bins <- compute_bins( data[[x]], scales[[x]], @@ -162,6 +69,62 @@ StatBin <- ggproto("StatBin", Stat, dropped_aes = "weight" # after statistical transformation, weights are no longer available ) +#' @param binwidth The width of the bins. Can be specified as a numeric value +#' or as a function that takes x after scale transformation as input and +#' returns a single numeric value. When specifying a function along with a +#' grouping structure, the function will be called once per group. +#' The default is to use the number of bins in `bins`, +#' covering the range of the data. You should always override +#' this value, exploring multiple widths to find the best to illustrate the +#' stories in your data. +#' +#' The bin width of a date variable is the number of days in each time; the +#' bin width of a time variable is the number of seconds. +#' @param bins Number of bins. Overridden by `binwidth`. Defaults to 30. +#' @param center,boundary bin position specifiers. Only one, `center` or +#' `boundary`, may be specified for a single plot. `center` specifies the +#' center of one of the bins. `boundary` specifies the boundary between two +#' bins. Note that if either is above or below the range of the data, things +#' will be shifted by the appropriate integer multiple of `binwidth`. +#' For example, to center on integers use `binwidth = 1` and `center = 0`, even +#' if `0` is outside the range of the data. Alternatively, this same alignment +#' can be specified with `binwidth = 1` and `boundary = 0.5`, even if `0.5` is +#' outside the range of the data. +#' @param breaks Alternatively, you can supply a numeric vector giving +#' the bin boundaries. Overrides `binwidth`, `bins`, `center`, +#' and `boundary`. Can also be a function that takes group-wise values as input and returns bin boundaries. +#' @param closed One of `"right"` or `"left"` indicating whether right +#' or left edges of bins are included in the bin. +#' @param pad If `TRUE`, adds empty bins at either end of x. This ensures +#' frequency polygons touch 0. Defaults to `FALSE`. +#' @param drop Treatment of zero count bins. If `"all"` (default), such +#' bins are kept as-is. If `"none"`, all zero count bins are filtered out. +#' If `"inner"` only zero count bins at the flanks are filtered out, but not +#' in the middle. `TRUE` is shorthand for `"all"` and `FALSE` is shorthand +#' for `"none"`. +#' @eval rd_computed_vars( +#' count = "number of points in bin.", +#' density = "density of points in bin, scaled to integrate to 1.", +#' ncount = "count, scaled to a maximum of 1.", +#' ndensity = "density, scaled to a maximum of 1.", +#' width = "widths of bins." +#' ) +#' +#' @section Dropped variables: +#' \describe{ +#' \item{`weight`}{After binning, weights of individual data points (if supplied) are no longer available.} +#' } +#' +#' @seealso [stat_count()], which counts the number of cases at each x +#' position, without binning. It is suitable for both discrete and continuous +#' x data, whereas `stat_bin()` is suitable only for continuous x data. +#' @export +#' @rdname geom_histogram +stat_bin <- make_constructor( + StatBin, geom = "bar", position = "stack", + orientation = NA +) + inner_runs <- function(x) { rle <- vec_unrep(x) nruns <- nrow(rle) @@ -170,4 +133,3 @@ inner_runs <- function(x) { inner[i] <- inner[i] & rle$key[i] rep(inner, rle$times) } - diff --git a/R/stat-bin2d.R b/R/stat-bin2d.R index fe27a41162..0aab17eb41 100644 --- a/R/stat-bin2d.R +++ b/R/stat-bin2d.R @@ -1,59 +1,3 @@ -#' @inheritParams stat_bin -#' @param drop if `TRUE` removes all cells with 0 counts. -#' @export -#' @rdname geom_bin_2d -#' @eval rd_computed_vars( -#' count = "number of points in bin.", -#' density = "density of points in bin, scaled to integrate to 1.", -#' ncount = "count, scaled to maximum of 1.", -#' ndensity = "density, scaled to a maximum of 1." -#' ) -#' @section Controlling binning parameters for the x and y directions: -#' The arguments `bins`, `binwidth`, `breaks`, `center`, and `boundary` can -#' be set separately for the x and y directions. When given as a scalar, one -#' value applies to both directions. When given as a vector of length two, -#' the first is applied to the x direction and the second to the y direction. -#' Alternatively, these can be a named list containing `x` and `y` elements, -#' for example `list(x = 10, y = 20)`. -stat_bin_2d <- function(mapping = NULL, data = NULL, - geom = "tile", position = "identity", - ..., - bins = 30, - binwidth = NULL, - center = NULL, - boundary = NULL, - breaks = NULL, - drop = TRUE, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatBin2d, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - center = center, - boundary = boundary, - breaks = breaks, - drop = drop, - na.rm = na.rm, - ... - ) - ) -} - - -#' @export -#' @rdname geom_bin_2d -#' @usage NULL -stat_bin2d <- stat_bin_2d - #' @rdname ggplot2-ggproto #' @include stat-summary-2d.R #' @format NULL @@ -65,7 +9,7 @@ StatBin2d <- ggproto( required_aes = c("x", "y"), compute_group = function(data, scales, binwidth = NULL, bins = 30, - breaks = NULL, origin = NULL, drop = TRUE, + breaks = NULL, drop = TRUE, boundary = NULL, closed = NULL, center = NULL) { data$z <- data$weight %||% 1 @@ -88,6 +32,32 @@ StatBin2d <- ggproto( } ) +#' @inheritParams stat_bin +#' @param drop if `TRUE` removes all cells with 0 counts. +#' @export +#' @rdname geom_bin_2d +#' @eval rd_computed_vars( +#' count = "number of points in bin.", +#' density = "density of points in bin, scaled to integrate to 1.", +#' ncount = "count, scaled to maximum of 1.", +#' ndensity = "density, scaled to a maximum of 1." +#' ) +#' @section Controlling binning parameters for the x and y directions: +#' The arguments `bins`, `binwidth`, `breaks`, `center`, and `boundary` can +#' be set separately for the x and y directions. When given as a scalar, one +#' value applies to both directions. When given as a vector of length two, +#' the first is applied to the x direction and the second to the y direction. +#' Alternatively, these can be a named list containing `x` and `y` elements, +#' for example `list(x = 10, y = 20)`. +stat_bin_2d <- make_constructor( + StatBin2d, geom = "tile" +) + +#' @export +#' @rdname geom_bin_2d +#' @usage NULL +stat_bin2d <- stat_bin_2d + dual_param <- function(x, default = list(x = NULL, y = NULL)) { if (is.null(x)) { default diff --git a/R/stat-binhex.R b/R/stat-binhex.R index be5b61daf7..d4c9da868e 100644 --- a/R/stat-binhex.R +++ b/R/stat-binhex.R @@ -1,54 +1,9 @@ -#' @export -#' @rdname geom_hex -#' @inheritParams stat_bin_2d -#' @eval rd_computed_vars( -#' count = "number of points in bin.", -#' density = "density of points in bin, scaled to integrate to 1.", -#' ncount = "count, scaled to maximum of 1.", -#' ndensity = "density, scaled to maximum of 1." -#' ) -#' @section Controlling binning parameters for the x and y directions: -#' The arguments `bins` and `binwidth` can -#' be set separately for the x and y directions. When given as a scalar, one -#' value applies to both directions. When given as a vector of length two, -#' the first is applied to the x direction and the second to the y direction. -#' Alternatively, these can be a named list containing `x` and `y` elements, -#' for example `list(x = 10, y = 20)`. -stat_bin_hex <- function(mapping = NULL, data = NULL, - geom = "hex", position = "identity", - ..., - bins = 30, - binwidth = NULL, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatBinhex, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - na.rm = na.rm, - ... - ) - ) -} - -#' @export -#' @rdname geom_hex -#' @usage NULL -stat_binhex <- stat_bin_hex - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatBinhex <- ggproto("StatBinhex", Stat, +StatBinhex <- ggproto( + "StatBinhex", Stat, default_aes = aes(weight = 1, fill = after_stat(count)), required_aes = c("x", "y"), @@ -73,3 +28,25 @@ StatBinhex <- ggproto("StatBinhex", Stat, dropped_aes = "weight" ) +#' @export +#' @rdname geom_hex +#' @inheritParams stat_bin_2d +#' @eval rd_computed_vars( +#' count = "number of points in bin.", +#' density = "density of points in bin, scaled to integrate to 1.", +#' ncount = "count, scaled to maximum of 1.", +#' ndensity = "density, scaled to maximum of 1." +#' ) +#' @section Controlling binning parameters for the x and y directions: +#' The arguments `bins` and `binwidth` can +#' be set separately for the x and y directions. When given as a scalar, one +#' value applies to both directions. When given as a vector of length two, +#' the first is applied to the x direction and the second to the y direction. +#' Alternatively, these can be a named list containing `x` and `y` elements, +#' for example `list(x = 10, y = 20)`. +stat_bin_hex <- make_constructor(StatBinhex, geom = "hex") + +#' @export +#' @rdname geom_hex +#' @usage NULL +stat_binhex <- stat_bin_hex diff --git a/R/stat-boxplot.R b/R/stat-boxplot.R index 46ce14879f..77336cb547 100644 --- a/R/stat-boxplot.R +++ b/R/stat-boxplot.R @@ -1,47 +1,3 @@ -#' @rdname geom_boxplot -#' @param coef Length of the whiskers as multiple of IQR. Defaults to 1.5. -#' @inheritParams stat_identity -#' @export -#' @eval rd_computed_vars( -#' .details = "`stat_boxplot()` provides the following variables, some of -#' which depend on the orientation:", -#' width = "width of boxplot.", -#' "ymin|xmin" = "lower whisker = smallest observation greater than or equal -#' to lower hinger - 1.5 * IQR.", -#' "lower|xlower" = "lower hinge, 25% quantile.", -#' notchlower = "lower edge of notch = median - 1.58 * IQR / sqrt(n).", -#' "middle|xmiddle" = "median, 50% quantile.", -#' notchupper = "upper edge of notch = median + 1.58 * IQR / sqrt(n).", -#' "upper|xupper" = "upper hinge, 75% quantile.", -#' "ymax|xmax" = "upper whisker = largest observation less than or equal to -#' upper hinger + 1.5 * IQR." -#' ) -stat_boxplot <- function(mapping = NULL, data = NULL, - geom = "boxplot", position = "dodge2", - ..., - coef = 1.5, - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatBoxplot, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - orientation = orientation, - coef = coef, - ... - ) - ) -} - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -131,3 +87,26 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, flip_data(df, flipped_aes) } ) + +#' @rdname geom_boxplot +#' @param coef Length of the whiskers as multiple of IQR. Defaults to 1.5. +#' @inheritParams stat_identity +#' @export +#' @eval rd_computed_vars( +#' .details = "`stat_boxplot()` provides the following variables, some of +#' which depend on the orientation:", +#' width = "width of boxplot.", +#' "ymin|xmin" = "lower whisker = smallest observation greater than or equal +#' to lower hinger - 1.5 * IQR.", +#' "lower|xlower" = "lower hinge, 25% quantile.", +#' notchlower = "lower edge of notch = median - 1.58 * IQR / sqrt(n).", +#' "middle|xmiddle" = "median, 50% quantile.", +#' notchupper = "upper edge of notch = median + 1.58 * IQR / sqrt(n).", +#' "upper|xupper" = "upper hinge, 75% quantile.", +#' "ymax|xmax" = "upper whisker = largest observation less than or equal to +#' upper hinger + 1.5 * IQR." +#' ) +stat_boxplot <- make_constructor( + StatBoxplot, geom = "boxplot", position = "dodge2", + orientation = NA, omit = "width" +) diff --git a/R/stat-contour.R b/R/stat-contour.R index 0602ed3899..ef570e9f0b 100644 --- a/R/stat-contour.R +++ b/R/stat-contour.R @@ -1,92 +1,9 @@ -#' @inheritParams stat_identity -#' @inheritParams geom_contour -#' @export -#' @eval rd_aesthetics("stat", "contour") -#' @eval rd_aesthetics("stat", "contour_filled") -#' @eval rd_computed_vars( -#' .details = "The computed variables differ somewhat for contour lines -#' (computed by `stat_contour()`) and contour bands (filled contours, -#' computed by `stat_contour_filled()`). The variables `nlevel` and `piece` -#' are available for both, whereas `level_low`, `level_high`, and `level_mid` -#' are only available for bands. The variable `level` is a numeric or a factor -#' depending on whether lines or bands are calculated.", -#' level = "Height of contour. For contour lines, this is a numeric vector -#' that represents bin boundaries. For contour bands, this is an ordered -#' factor that represents bin ranges.", -#' "level_low,level_high,level_mid" = "(contour bands only) Lower and upper -#' bin boundaries for each band, as well as the mid point between boundaries.", -#' nlevel = "Height of contour, scaled to a maximum of 1.", -#' piece = "Contour piece (an integer)." -#' ) -#' -#' @section Dropped variables: -#' \describe{ -#' \item{`z`}{After contouring, the z values of individual data points are no longer available.} -#' } -#' -#' -#' @rdname geom_contour -stat_contour <- function(mapping = NULL, data = NULL, - geom = "contour", position = "identity", - ..., - bins = NULL, - binwidth = NULL, - breaks = NULL, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatContour, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - breaks = breaks, - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname geom_contour -#' @export -stat_contour_filled <- function(mapping = NULL, data = NULL, - geom = "contour_filled", position = "identity", - ..., - bins = NULL, - binwidth = NULL, - breaks = NULL, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatContourFilled, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - breaks = breaks, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatContour <- ggproto("StatContour", Stat, +StatContour <- ggproto( + "StatContour", Stat, required_aes = c("x", "y", "z"), default_aes = aes(order = after_stat(level)), @@ -126,7 +43,8 @@ StatContour <- ggproto("StatContour", Stat, #' @format NULL #' @usage NULL #' @export -StatContourFilled <- ggproto("StatContourFilled", Stat, +StatContourFilled <- ggproto( + "StatContourFilled", Stat, required_aes = c("x", "y", "z"), default_aes = aes(order = after_stat(level), fill = after_stat(level)), @@ -166,6 +84,46 @@ StatContourFilled <- ggproto("StatContourFilled", Stat, } ) +#' @inheritParams stat_identity +#' @inheritParams geom_contour +#' @export +#' @eval rd_aesthetics("stat", "contour") +#' @eval rd_aesthetics("stat", "contour_filled") +#' @eval rd_computed_vars( +#' .details = "The computed variables differ somewhat for contour lines +#' (computed by `stat_contour()`) and contour bands (filled contours, +#' computed by `stat_contour_filled()`). The variables `nlevel` and `piece` +#' are available for both, whereas `level_low`, `level_high`, and `level_mid` +#' are only available for bands. The variable `level` is a numeric or a factor +#' depending on whether lines or bands are calculated.", +#' level = "Height of contour. For contour lines, this is a numeric vector +#' that represents bin boundaries. For contour bands, this is an ordered +#' factor that represents bin ranges.", +#' "level_low,level_high,level_mid" = "(contour bands only) Lower and upper +#' bin boundaries for each band, as well as the mid point between boundaries.", +#' nlevel = "Height of contour, scaled to a maximum of 1.", +#' piece = "Contour piece (an integer)." +#' ) +#' +#' @section Dropped variables: +#' \describe{ +#' \item{`z`}{After contouring, the z values of individual data points are no longer available.} +#' } +#' +#' +#' @rdname geom_contour +stat_contour <- make_constructor( + StatContour, geom = "contour", + omit = "z.range" +) + +#' @rdname geom_contour +#' @export +stat_contour_filled <- make_constructor( + StatContourFilled, geom = "contour_filled", + omit = "z.range" +) + #' Calculate the breaks used for contouring #' #' @inheritParams geom_contour diff --git a/R/stat-count.R b/R/stat-count.R index fd78d1beaa..7768b9e191 100644 --- a/R/stat-count.R +++ b/R/stat-count.R @@ -1,47 +1,10 @@ -#' @eval rd_computed_vars( -#' count = "number of points in bin.", -#' prop = "groupwise proportion" -#' ) -#' @seealso [stat_bin()], which bins data in ranges and counts the -#' cases in each range. It differs from `stat_count()`, which counts the -#' number of cases at each `x` position (without binning into ranges). -#' [stat_bin()] requires continuous `x` data, whereas -#' `stat_count()` can be used for both discrete and continuous `x` data. -#' -#' @export -#' @rdname geom_bar -stat_count <- function(mapping = NULL, data = NULL, - geom = "bar", position = "stack", - ..., - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - - params <- list2( - na.rm = na.rm, - orientation = orientation, - ... - ) - - layer( - data = data, - mapping = mapping, - stat = StatCount, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = params - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export #' @include stat-.R -StatCount <- ggproto("StatCount", Stat, +StatCount <- ggproto( + "StatCount", Stat, required_aes = "x|y", default_aes = aes(x = after_stat(count), y = after_stat(count), weight = 1), @@ -88,3 +51,20 @@ StatCount <- ggproto("StatCount", Stat, dropped_aes = "weight" ) + +#' @eval rd_computed_vars( +#' count = "number of points in bin.", +#' prop = "groupwise proportion" +#' ) +#' @seealso [stat_bin()], which bins data in ranges and counts the +#' cases in each range. It differs from `stat_count()`, which counts the +#' number of cases at each `x` position (without binning into ranges). +#' [stat_bin()] requires continuous `x` data, whereas +#' `stat_count()` can be used for both discrete and continuous `x` data. +#' +#' @export +#' @rdname geom_bar +stat_count <- make_constructor( + StatCount, geom = "bar", position = "stack", + orientation = NA, omit = "width" +) diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index af2b10b14d..87465282a8 100644 --- a/R/stat-density-2d.R +++ b/R/stat-density-2d.R @@ -1,126 +1,9 @@ -#' @export -#' @rdname geom_density_2d -#' @param contour If `TRUE`, contour the results of the 2d density -#' estimation. -#' @param contour_var Character string identifying the variable to contour -#' by. Can be one of `"density"`, `"ndensity"`, or `"count"`. See the section -#' on computed variables for details. -#' @inheritDotParams geom_contour bins binwidth breaks -#' @param n Number of grid points in each direction. -#' @param h Bandwidth (vector of length two). If `NULL`, estimated -#' using [MASS::bandwidth.nrd()]. -#' @param adjust A multiplicative bandwidth adjustment to be used if 'h' is -#' 'NULL'. This makes it possible to adjust the bandwidth while still -#' using the a bandwidth estimator. For example, `adjust = 1/2` means -#' use half of the default bandwidth. -#' @eval rd_computed_vars( -#' .details = "`stat_density_2d()` and `stat_density_2d_filled()` compute -#' different variables depending on whether contouring is turned on or off. -#' With contouring off (`contour = FALSE`), both stats behave the same, and -#' the following variables are provided:", -#' density = "The density estimate.", -#' ndensity = "Density estimate, scaled to a maximum of 1.", -#' count = "Density estimate * number of observations in group.", -#' n = "Number of observations in each group." -#' ) -#' -#' @section Computed variables: -#' With contouring on (`contour = TRUE`), either [stat_contour()] or -#' [stat_contour_filled()] (for contour lines or contour bands, -#' respectively) is run after the density estimate has been obtained, -#' and the computed variables are determined by these stats. -#' Contours are calculated for one of the three types of density estimates -#' obtained before contouring, `density`, `ndensity`, and `count`. Which -#' of those should be used is determined by the `contour_var` parameter. -#' -#' @section Dropped variables: -#' \describe{ -#' \item{`z`}{After density estimation, the z values of individual data points are no longer available.} -#' } -#' -#' If contouring is enabled, then similarly `density`, `ndensity`, and `count` -#' are no longer available after the contouring pass. -#' -stat_density_2d <- function(mapping = NULL, data = NULL, - geom = "density_2d", position = "identity", - ..., - contour = TRUE, - contour_var = "density", - n = 100, - h = NULL, - adjust = c(1, 1), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatDensity2d, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - contour = contour, - contour_var = contour_var, - n = n, - h = h, - adjust = adjust, - ... - ) - ) -} - -#' @rdname geom_density_2d -#' @usage NULL -#' @export -stat_density2d <- stat_density_2d - -#' @rdname geom_density_2d -#' @export -stat_density_2d_filled <- function(mapping = NULL, data = NULL, - geom = "density_2d_filled", position = "identity", - ..., - contour = TRUE, - contour_var = "density", - n = 100, - h = NULL, - adjust = c(1, 1), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatDensity2dFilled, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - contour = contour, - contour_var = contour_var, - n = n, - h = h, - adjust = adjust, - ... - ) - ) -} - -#' @rdname geom_density_2d -#' @usage NULL -#' @export -stat_density2d_filled <- stat_density_2d_filled - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatDensity2d <- ggproto("StatDensity2d", Stat, +StatDensity2d <- ggproto( + "StatDensity2d", Stat, default_aes = aes(colour = "#3366FF", size = 0.5), required_aes = c("x", "y"), @@ -203,14 +86,77 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, } ) - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatDensity2dFilled <- ggproto("StatDensity2dFilled", StatDensity2d, +StatDensity2dFilled <- ggproto( + "StatDensity2dFilled", StatDensity2d, default_aes = aes(colour = NA, fill = after_stat(level)), contour_type = "bands" ) +#' @export +#' @rdname geom_density_2d +#' @param contour If `TRUE`, contour the results of the 2d density +#' estimation. +#' @param contour_var Character string identifying the variable to contour +#' by. Can be one of `"density"`, `"ndensity"`, or `"count"`. See the section +#' on computed variables for details. +#' @inheritDotParams geom_contour bins binwidth breaks +#' @param n Number of grid points in each direction. +#' @param h Bandwidth (vector of length two). If `NULL`, estimated +#' using [MASS::bandwidth.nrd()]. +#' @param adjust A multiplicative bandwidth adjustment to be used if 'h' is +#' 'NULL'. This makes it possible to adjust the bandwidth while still +#' using the a bandwidth estimator. For example, `adjust = 1/2` means +#' use half of the default bandwidth. +#' @eval rd_computed_vars( +#' .details = "`stat_density_2d()` and `stat_density_2d_filled()` compute +#' different variables depending on whether contouring is turned on or off. +#' With contouring off (`contour = FALSE`), both stats behave the same, and +#' the following variables are provided:", +#' density = "The density estimate.", +#' ndensity = "Density estimate, scaled to a maximum of 1.", +#' count = "Density estimate * number of observations in group.", +#' n = "Number of observations in each group." +#' ) +#' +#' @section Computed variables: +#' With contouring on (`contour = TRUE`), either [stat_contour()] or +#' [stat_contour_filled()] (for contour lines or contour bands, +#' respectively) is run after the density estimate has been obtained, +#' and the computed variables are determined by these stats. +#' Contours are calculated for one of the three types of density estimates +#' obtained before contouring, `density`, `ndensity`, and `count`. Which +#' of those should be used is determined by the `contour_var` parameter. +#' +#' @section Dropped variables: +#' \describe{ +#' \item{`z`}{After density estimation, the z values of individual data points are no longer available.} +#' } +#' +#' If contouring is enabled, then similarly `density`, `ndensity`, and `count` +#' are no longer available after the contouring pass. +#' +stat_density_2d <- make_constructor( + StatDensity2d, geom = "density_2d", + contour = TRUE, contour_var = "density" +) + +#' @rdname geom_density_2d +#' @usage NULL +#' @export +stat_density2d <- stat_density_2d + +#' @rdname geom_density_2d +#' @export +stat_density_2d_filled <- make_constructor( + StatDensity2dFilled, geom = "density_2d_filled", + contour = TRUE, contour_var = "density" +) + +#' @rdname geom_density_2d +#' @usage NULL +#' @export +stat_density2d_filled <- stat_density_2d_filled diff --git a/R/stat-density.R b/R/stat-density.R index 5b948f5d88..7614c99000 100644 --- a/R/stat-density.R +++ b/R/stat-density.R @@ -1,78 +1,9 @@ -#' @param bw The smoothing bandwidth to be used. -#' If numeric, the standard deviation of the smoothing kernel. -#' If character, a rule to choose the bandwidth, as listed in -#' [stats::bw.nrd()]. Note that automatic calculation of the bandwidth does -#' not take weights into account. -#' @param adjust A multiplicate bandwidth adjustment. This makes it possible -#' to adjust the bandwidth while still using the a bandwidth estimator. -#' For example, `adjust = 1/2` means use half of the default bandwidth. -#' @param kernel Kernel. See list of available kernels in [density()]. -#' @param n number of equally spaced points at which the density is to be -#' estimated, should be a power of two, see [density()] for -#' details -#' @param trim If `FALSE`, the default, each density is computed on the -#' full range of the data. If `TRUE`, each density is computed over the -#' range of that group: this typically means the estimated x values will -#' not line-up, and hence you won't be able to stack density values. -#' This parameter only matters if you are displaying multiple densities in -#' one plot or if you are manually adjusting the scale limits. -#' @param bounds Known lower and upper bounds for estimated data. Default -#' `c(-Inf, Inf)` means that there are no (finite) bounds. If any bound is -#' finite, boundary effect of default density estimation will be corrected by -#' reflecting tails outside `bounds` around their closest edge. Data points -#' outside of bounds are removed with a warning. -#' @eval rd_computed_vars( -#' density = "density estimate.", -#' count = "density * number of points - useful for stacked density plots.", -#' wdensity = "density * sum of weights. In absence of weights, the same as -#' `count`.", -#' scaled = "density estimate, scaled to maximum of 1.", -#' n = "number of points.", -#' ndensity = "alias for `scaled`, to mirror the syntax of [`stat_bin()`]." -#' ) -#' @export -#' @rdname geom_density -stat_density <- function(mapping = NULL, data = NULL, - geom = "area", position = "stack", - ..., - bw = "nrd0", - adjust = 1, - kernel = "gaussian", - n = 512, - trim = FALSE, - na.rm = FALSE, - bounds = c(-Inf, Inf), - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - - layer( - data = data, - mapping = mapping, - stat = StatDensity, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bw = bw, - adjust = adjust, - kernel = kernel, - n = n, - trim = trim, - na.rm = na.rm, - bounds = bounds, - orientation = orientation, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatDensity <- ggproto("StatDensity", Stat, +StatDensity <- ggproto( + "StatDensity", Stat, required_aes = "x|y", default_aes = aes(x = after_stat(density), y = after_stat(density), fill = NA, weight = NULL), @@ -104,12 +35,50 @@ StatDensity <- ggproto("StatDensity", Stat, } density <- compute_density(data$x, data$weight, from = range[1], - to = range[2], bw = bw, adjust = adjust, kernel = kernel, n = n, - bounds = bounds) + to = range[2], bw = bw, adjust = adjust, kernel = kernel, n = n, + bounds = bounds) density$flipped_aes <- flipped_aes flip_data(density, flipped_aes) } +) +#' @param bw The smoothing bandwidth to be used. +#' If numeric, the standard deviation of the smoothing kernel. +#' If character, a rule to choose the bandwidth, as listed in +#' [stats::bw.nrd()]. Note that automatic calculation of the bandwidth does +#' not take weights into account. +#' @param adjust A multiplicate bandwidth adjustment. This makes it possible +#' to adjust the bandwidth while still using the a bandwidth estimator. +#' For example, `adjust = 1/2` means use half of the default bandwidth. +#' @param kernel Kernel. See list of available kernels in [density()]. +#' @param n number of equally spaced points at which the density is to be +#' estimated, should be a power of two, see [density()] for +#' details +#' @param trim If `FALSE`, the default, each density is computed on the +#' full range of the data. If `TRUE`, each density is computed over the +#' range of that group: this typically means the estimated x values will +#' not line-up, and hence you won't be able to stack density values. +#' This parameter only matters if you are displaying multiple densities in +#' one plot or if you are manually adjusting the scale limits. +#' @param bounds Known lower and upper bounds for estimated data. Default +#' `c(-Inf, Inf)` means that there are no (finite) bounds. If any bound is +#' finite, boundary effect of default density estimation will be corrected by +#' reflecting tails outside `bounds` around their closest edge. Data points +#' outside of bounds are removed with a warning. +#' @eval rd_computed_vars( +#' density = "density estimate.", +#' count = "density * number of points - useful for stacked density plots.", +#' wdensity = "density * sum of weights. In absence of weights, the same as +#' `count`.", +#' scaled = "density estimate, scaled to maximum of 1.", +#' n = "number of points.", +#' ndensity = "alias for `scaled`, to mirror the syntax of [`stat_bin()`]." +#' ) +#' @export +#' @rdname geom_density +stat_density <- make_constructor( + StatDensity, geom = "area", position = "stack", + orientation = NA ) compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, diff --git a/R/stat-ecdf.R b/R/stat-ecdf.R index 96430b1e32..798f3160e8 100644 --- a/R/stat-ecdf.R +++ b/R/stat-ecdf.R @@ -1,3 +1,52 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +StatEcdf <- ggproto( + "StatEcdf", Stat, + required_aes = c("x|y"), + + default_aes = aes(x = after_stat(ecdf), y = after_stat(ecdf), weight = NULL), + + setup_params = function(self, data, params) { + params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE, main_is_continuous = TRUE) + + has_x <- !(is.null(data$x) && is.null(params$x)) + has_y <- !(is.null(data$y) && is.null(params$y)) + if (!has_x && !has_y) { + cli::cli_abort("{.fn {snake_class(self)}} requires an {.field x} or {.field y} aesthetic.") + } + + params + }, + + compute_group = function(data, scales, n = NULL, pad = TRUE, flipped_aes = FALSE) { + data <- flip_data(data, flipped_aes) + # If n is NULL, use raw values; otherwise interpolate + if (is.null(n)) { + x <- unique0(data$x) + } else { + x <- seq(min(data$x), max(data$x), length.out = n) + } + + if (pad) { + x <- c(-Inf, x, Inf) + } + data_ecdf <- wecdf(data$x, data$weight)(x) + + df_ecdf <- data_frame0( + x = x, + y = data_ecdf, + ecdf = data_ecdf, + .size = length(x) + ) + df_ecdf$flipped_aes <- flipped_aes + flip_data(df_ecdf, flipped_aes) + }, + + dropped_aes = "weight" +) + #' Compute empirical cumulative distribution #' #' The empirical cumulative distribution function (ECDF) provides an alternative @@ -62,79 +111,7 @@ #' aes(weight = weights), #' data = weighted, colour = "green" #' ) -stat_ecdf <- function(mapping = NULL, data = NULL, - geom = "step", position = "identity", - ..., - n = NULL, - pad = TRUE, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatEcdf, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - n = n, - pad = pad, - na.rm = na.rm, - ... - ) - ) -} - - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -StatEcdf <- ggproto("StatEcdf", Stat, - required_aes = c("x|y"), - - default_aes = aes(x = after_stat(ecdf), y = after_stat(ecdf), weight = NULL), - - setup_params = function(self, data, params) { - params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE, main_is_continuous = TRUE) - - has_x <- !(is.null(data$x) && is.null(params$x)) - has_y <- !(is.null(data$y) && is.null(params$y)) - if (!has_x && !has_y) { - cli::cli_abort("{.fn {snake_class(self)}} requires an {.field x} or {.field y} aesthetic.") - } - - params - }, - - compute_group = function(data, scales, n = NULL, pad = TRUE, flipped_aes = FALSE) { - data <- flip_data(data, flipped_aes) - # If n is NULL, use raw values; otherwise interpolate - if (is.null(n)) { - x <- unique0(data$x) - } else { - x <- seq(min(data$x), max(data$x), length.out = n) - } - - if (pad) { - x <- c(-Inf, x, Inf) - } - data_ecdf <- wecdf(data$x, data$weight)(x) - - df_ecdf <- data_frame0( - x = x, - y = data_ecdf, - ecdf = data_ecdf, - .size = length(x) - ) - df_ecdf$flipped_aes <- flipped_aes - flip_data(df_ecdf, flipped_aes) - }, - - dropped_aes = "weight" -) +stat_ecdf <- make_constructor(StatEcdf, geom = "step") # Weighted eCDF function wecdf <- function(x, weights = NULL) { diff --git a/R/stat-ellipse.R b/R/stat-ellipse.R index d462bf3575..305a7705e2 100644 --- a/R/stat-ellipse.R +++ b/R/stat-ellipse.R @@ -1,3 +1,28 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +StatEllipse <- ggproto( + "StatEllipse", Stat, + required_aes = c("x", "y"), + optional_aes = "weight", + dropped_aes = "weight", + + setup_params = function(data, params) { + params$type <- params$type %||% "t" + if (identical(params$type, "t")) { + check_installed("MASS", "for calculating ellipses with `type = \"t\"`.") + } + params + }, + + compute_group = function(data, scales, type = "t", level = 0.95, + segments = 51, na.rm = FALSE) { + calculate_ellipse(data = data, vars = c("x", "y"), type = type, + level = level, segments = segments) + } +) + #' Compute normal data ellipses #' #' The method for calculating the ellipses has been modified from @@ -44,56 +69,7 @@ #' #' ggplot(faithful, aes(waiting, eruptions, fill = eruptions > 3)) + #' stat_ellipse(geom = "polygon") -stat_ellipse <- function(mapping = NULL, data = NULL, - geom = "path", position = "identity", - ..., - type = "t", - level = 0.95, - segments = 51, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatEllipse, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - type = type, - level = level, - segments = segments, - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -StatEllipse <- ggproto("StatEllipse", Stat, - required_aes = c("x", "y"), - optional_aes = "weight", - dropped_aes = "weight", - - setup_params = function(data, params) { - params$type <- params$type %||% "t" - if (identical(params$type, "t")) { - check_installed("MASS", "for calculating ellipses with `type = \"t\"`.") - } - params - }, - - compute_group = function(data, scales, type = "t", level = 0.95, - segments = 51, na.rm = FALSE) { - calculate_ellipse(data = data, vars = c("x", "y"), type = type, - level = level, segments = segments) - } -) +stat_ellipse <- make_constructor(StatEllipse, geom = "path") calculate_ellipse <- function(data, vars, type, level, segments){ dfn <- 2 diff --git a/R/stat-function.R b/R/stat-function.R index bf6d2e4b74..3c70b6b54d 100644 --- a/R/stat-function.R +++ b/R/stat-function.R @@ -1,55 +1,9 @@ -#' @param fun Function to use. Either 1) an anonymous function in the base or -#' rlang formula syntax (see [rlang::as_function()]) -#' or 2) a quoted or character name referencing a function; see examples. Must -#' be vectorised. -#' @param n Number of points to interpolate along the x axis. -#' @param args List of additional arguments passed on to the function defined by `fun`. -#' @param xlim Optionally, specify the range of the function. -#' @eval rd_computed_vars( -#' x = "`x` values along a grid.", -#' y = "values of the function evaluated at corresponding `x`." -#' ) -#' @seealso [rlang::as_function()] -#' @export -#' @rdname geom_function -stat_function <- function(mapping = NULL, data = NULL, - geom = "function", position = "identity", - ..., - fun, - xlim = NULL, - n = 101, - args = list(), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - if (is.null(data)) { - data <- ensure_nonempty_data - } - - layer( - data = data, - mapping = mapping, - stat = StatFunction, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - fun = fun, - n = n, - args = args, - na.rm = na.rm, - xlim = xlim, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatFunction <- ggproto("StatFunction", Stat, +StatFunction <- ggproto( + "StatFunction", Stat, default_aes = aes(x = NULL, y = after_scale(y)), compute_group = function(data, scales, fun, xlim = NULL, n = 101, args = list()) { @@ -82,6 +36,25 @@ StatFunction <- ggproto("StatFunction", Stat, } ) +#' @param fun Function to use. Either 1) an anonymous function in the base or +#' rlang formula syntax (see [rlang::as_function()]) +#' or 2) a quoted or character name referencing a function; see examples. Must +#' be vectorised. +#' @param n Number of points to interpolate along the x axis. +#' @param args List of additional arguments passed on to the function defined by `fun`. +#' @param xlim Optionally, specify the range of the function. +#' @eval rd_computed_vars( +#' x = "`x` values along a grid.", +#' y = "values of the function evaluated at corresponding `x`." +#' ) +#' @seealso [rlang::as_function()] +#' @export +#' @rdname geom_function +stat_function <- make_constructor( + StatFunction, geom = "function", fun = , + checks = exprs(data <- data %||% ensure_nonempty_data) +) + # Convenience function used by `stat_function()` and # `geom_function()` to convert empty input data into # non-empty input data without touching any non-empty diff --git a/R/stat-identity.R b/R/stat-identity.R index 86c8c09b95..67ef0848e5 100644 --- a/R/stat-identity.R +++ b/R/stat-identity.R @@ -1,3 +1,14 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +StatIdentity <- ggproto( + "StatIdentity", Stat, + compute_layer = function(self, data, params, layout) { + data + } +) + #' Leave data as is #' #' The identity statistic leaves the data unchanged. @@ -8,32 +19,4 @@ #' @examples #' p <- ggplot(mtcars, aes(wt, mpg)) #' p + stat_identity() -stat_identity <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", - ..., - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatIdentity, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = FALSE, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -StatIdentity <- ggproto("StatIdentity", Stat, - compute_layer = function(self, data, params, layout) { - data - } -) +stat_identity <- make_constructor(StatIdentity, geom = "point") diff --git a/R/stat-qq-line.R b/R/stat-qq-line.R index ab6c194cfe..0c0df76ff7 100644 --- a/R/stat-qq-line.R +++ b/R/stat-qq-line.R @@ -1,49 +1,9 @@ -#' @rdname geom_qq -#' @export -#' @param line.p Vector of quantiles to use when fitting the Q-Q line, defaults -#' defaults to `c(.25, .75)`. -#' @param fullrange Should the q-q line span the full range of the plot, or just -#' the data -geom_qq_line <- function(mapping = NULL, - data = NULL, - geom = "abline", - position = "identity", - ..., - distribution = stats::qnorm, - dparams = list(), - line.p = c(0.25, 0.75), - fullrange = FALSE, - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatQqLine, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - distribution = distribution, - dparams = dparams, - na.rm = na.rm, - line.p = line.p, - fullrange = fullrange, - ... - ) - ) -} - -#' @export -#' @rdname geom_qq -stat_qq_line <- geom_qq_line - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatQqLine <- ggproto("StatQqLine", Stat, +StatQqLine <- ggproto( + "StatQqLine", Stat, default_aes = aes(x = after_stat(x), y = after_stat(y)), required_aes = c("sample"), @@ -92,3 +52,15 @@ StatQqLine <- ggproto("StatQqLine", Stat, ) } ) + +#' @rdname geom_qq +#' @export +#' @param line.p Vector of quantiles to use when fitting the Q-Q line, defaults +#' defaults to `c(.25, .75)`. +#' @param fullrange Should the q-q line span the full range of the plot, or just +#' the data +geom_qq_line <- make_constructor(StatQqLine, geom = "abline", omit = "quantiles") + +#' @export +#' @rdname geom_qq +stat_qq_line <- geom_qq_line diff --git a/R/stat-qq.R b/R/stat-qq.R index 71068bbd04..64a481574d 100644 --- a/R/stat-qq.R +++ b/R/stat-qq.R @@ -1,3 +1,33 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +StatQq <- ggproto( + "StatQq", Stat, + default_aes = aes(y = after_stat(sample), x = after_stat(theoretical)), + + required_aes = c("sample"), + + compute_group = function(self, data, scales, quantiles = NULL, + distribution = stats::qnorm, dparams = list(), + na.rm = FALSE) { + + sample <- sort(data$sample) + n <- length(sample) + + # Compute theoretical quantiles + if (is.null(quantiles)) { + quantiles <- stats::ppoints(n) + } else if (length(quantiles) != n) { + cli::cli_abort("The length of {.arg quantiles} must match the length of the data.") + } + + theoretical <- inject(distribution(p = quantiles, !!!dparams)) + + data_frame0(sample = sample, theoretical = theoretical) + } +) + #' A quantile-quantile plot #' #' `geom_qq()` and `stat_qq()` produce quantile-quantile plots. `geom_qq_line()` and @@ -52,60 +82,8 @@ #' stat_qq() + #' stat_qq_line() #' } -geom_qq <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", - ..., - distribution = stats::qnorm, - dparams = list(), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatQq, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - distribution = distribution, - dparams = dparams, - na.rm = na.rm, - ... - ) - ) -} +geom_qq <- make_constructor(StatQq, geom = "point", omit = "quantiles") #' @export #' @rdname geom_qq stat_qq <- geom_qq - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -StatQq <- ggproto("StatQq", Stat, - default_aes = aes(y = after_stat(sample), x = after_stat(theoretical)), - - required_aes = c("sample"), - - compute_group = function(self, data, scales, quantiles = NULL, - distribution = stats::qnorm, dparams = list(), - na.rm = FALSE) { - - sample <- sort(data$sample) - n <- length(sample) - - # Compute theoretical quantiles - if (is.null(quantiles)) { - quantiles <- stats::ppoints(n) - } else if (length(quantiles) != n) { - cli::cli_abort("The length of {.arg quantiles} must match the length of the data.") - } - - theoretical <- inject(distribution(p = quantiles, !!!dparams)) - - data_frame0(sample = sample, theoretical = theoretical) - } -) diff --git a/R/stat-quantilemethods.R b/R/stat-quantilemethods.R index 9afb7e0b92..48f30bbdfe 100644 --- a/R/stat-quantilemethods.R +++ b/R/stat-quantilemethods.R @@ -1,49 +1,9 @@ -#' @param quantiles conditional quantiles of y to calculate and display -#' @param formula formula relating y variables to x variables -#' @param method Quantile regression method to use. Available options are `"rq"` (for -#' [`quantreg::rq()`]) and `"rqss"` (for [`quantreg::rqss()`]). -#' @inheritParams layer -#' @inheritParams geom_point -#' @eval rd_computed_vars( -#' quantile = "Quantile of distribution." -#' ) -#' @export -#' @rdname geom_quantile -stat_quantile <- function(mapping = NULL, data = NULL, - geom = "quantile", position = "identity", - ..., - quantiles = c(0.25, 0.5, 0.75), - formula = NULL, - method = "rq", - method.args = list(), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatQuantile, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - quantiles = quantiles, - formula = formula, - method = method, - method.args = method.args, - na.rm = na.rm, - ... - ) - ) -} - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatQuantile <- ggproto("StatQuantile", Stat, +StatQuantile <- ggproto( + "StatQuantile", Stat, required_aes = c("x", "y"), compute_group = function(data, scales, quantiles = c(0.25, 0.5, 0.75), @@ -102,6 +62,22 @@ StatQuantile <- ggproto("StatQuantile", Stat, dropped_aes = "weight" ) +#' @param quantiles conditional quantiles of y to calculate and display +#' @param formula formula relating y variables to x variables +#' @param method Quantile regression method to use. Available options are `"rq"` (for +#' [`quantreg::rq()`]) and `"rqss"` (for [`quantreg::rqss()`]). +#' @inheritParams layer +#' @inheritParams geom_point +#' @eval rd_computed_vars( +#' quantile = "Quantile of distribution." +#' ) +#' @export +#' @rdname geom_quantile +stat_quantile <- make_constructor( + StatQuantile, geom = "quantile", + omit = c("xseq", "lambda") +) + quant_pred <- function(quantile, data, method, formula, weight, grid, method.args = method.args) { model <- inject(method( diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 147bd06e41..f2ebc2e22b 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -1,97 +1,9 @@ -#' @param method Smoothing method (function) to use, accepts either -#' `NULL` or a character vector, e.g. `"lm"`, `"glm"`, `"gam"`, `"loess"` -#' or a function, e.g. `MASS::rlm` or `mgcv::gam`, `stats::lm`, or `stats::loess`. -#' `"auto"` is also accepted for backwards compatibility. It is equivalent to -#' `NULL`. -#' -#' For `method = NULL` the smoothing method is chosen based on the -#' size of the largest group (across all panels). [stats::loess()] is -#' used for less than 1,000 observations; otherwise [mgcv::gam()] is -#' used with `formula = y ~ s(x, bs = "cs")` with `method = "REML"`. Somewhat anecdotally, -#' `loess` gives a better appearance, but is \eqn{O(N^{2})}{O(N^2)} in memory, -#' so does not work for larger datasets. -#' -#' If you have fewer than 1,000 observations but want to use the same `gam()` -#' model that `method = NULL` would use, then set -#' `method = "gam", formula = y ~ s(x, bs = "cs")`. -#' @param formula Formula to use in smoothing function, eg. `y ~ x`, -#' `y ~ poly(x, 2)`, `y ~ log(x)`. `NULL` by default, in which case -#' `method = NULL` implies `formula = y ~ x` when there are fewer than 1,000 -#' observations and `formula = y ~ s(x, bs = "cs")` otherwise. -#' @param se Display confidence band around smooth? (`TRUE` by default, see -#' `level` to control.) -#' @param fullrange If `TRUE`, the smoothing line gets expanded to the range of the plot, -#' potentially beyond the data. This does not extend the line into any additional padding -#' created by `expansion`. -#' @param xseq A numeric vector of values at which the smoother is evaluated. -#' When `NULL` (default), `xseq` is internally evaluated as a sequence of `n` -#' equally spaced points for continuous data. -#' @param level Level of confidence band to use (0.95 by default). -#' @param span Controls the amount of smoothing for the default loess smoother. -#' Smaller numbers produce wigglier lines, larger numbers produce smoother -#' lines. Only used with loess, i.e. when `method = "loess"`, -#' or when `method = NULL` (the default) and there are fewer than 1,000 -#' observations. -#' @param n Number of points at which to evaluate smoother. -#' @param method.args List of additional arguments passed on to the modelling -#' function defined by `method`. -#' -#' @eval rd_computed_vars( -#' .details = "`stat_smooth()` provides the following variables, some of -#' which depend on the orientation:", -#' "y|x" = "Predicted value.", -#' "ymin|xmin" = "Lower pointwise confidence band around the mean.", -#' "ymax|xmax" = "Upper pointwise confidence band around the mean.", -#' "se" = "Standard error." -#' ) -#' @export -#' @rdname geom_smooth -stat_smooth <- function(mapping = NULL, data = NULL, - geom = "smooth", position = "identity", - ..., - method = NULL, - formula = NULL, - se = TRUE, - n = 80, - span = 0.75, - fullrange = FALSE, - xseq = NULL, - level = 0.95, - method.args = list(), - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatSmooth, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - method = method, - formula = formula, - se = se, - n = n, - fullrange = fullrange, - level = level, - na.rm = na.rm, - orientation = orientation, - method.args = method.args, - span = span, - xseq = xseq, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatSmooth <- ggproto("StatSmooth", Stat, +StatSmooth <- ggproto( + "StatSmooth", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) msg <- character() @@ -214,6 +126,56 @@ StatSmooth <- ggproto("StatSmooth", Stat, required_aes = c("x", "y") ) +#' @param method Smoothing method (function) to use, accepts either +#' `NULL` or a character vector, e.g. `"lm"`, `"glm"`, `"gam"`, `"loess"` +#' or a function, e.g. `MASS::rlm` or `mgcv::gam`, `stats::lm`, or `stats::loess`. +#' `"auto"` is also accepted for backwards compatibility. It is equivalent to +#' `NULL`. +#' +#' For `method = NULL` the smoothing method is chosen based on the +#' size of the largest group (across all panels). [stats::loess()] is +#' used for less than 1,000 observations; otherwise [mgcv::gam()] is +#' used with `formula = y ~ s(x, bs = "cs")` with `method = "REML"`. Somewhat anecdotally, +#' `loess` gives a better appearance, but is \eqn{O(N^{2})}{O(N^2)} in memory, +#' so does not work for larger datasets. +#' +#' If you have fewer than 1,000 observations but want to use the same `gam()` +#' model that `method = NULL` would use, then set +#' `method = "gam", formula = y ~ s(x, bs = "cs")`. +#' @param formula Formula to use in smoothing function, eg. `y ~ x`, +#' `y ~ poly(x, 2)`, `y ~ log(x)`. `NULL` by default, in which case +#' `method = NULL` implies `formula = y ~ x` when there are fewer than 1,000 +#' observations and `formula = y ~ s(x, bs = "cs")` otherwise. +#' @param se Display confidence band around smooth? (`TRUE` by default, see +#' `level` to control.) +#' @param fullrange If `TRUE`, the smoothing line gets expanded to the range of the plot, +#' potentially beyond the data. This does not extend the line into any additional padding +#' created by `expansion`. +#' @param xseq A numeric vector of values at which the smoother is evaluated. +#' When `NULL` (default), `xseq` is internally evaluated as a sequence of `n` +#' equally spaced points for continuous data. +#' @param level Level of confidence band to use (0.95 by default). +#' @param span Controls the amount of smoothing for the default loess smoother. +#' Smaller numbers produce wigglier lines, larger numbers produce smoother +#' lines. Only used with loess, i.e. when `method = "loess"`, +#' or when `method = NULL` (the default) and there are fewer than 1,000 +#' observations. +#' @param n Number of points at which to evaluate smoother. +#' @param method.args List of additional arguments passed on to the modelling +#' function defined by `method`. +#' +#' @eval rd_computed_vars( +#' .details = "`stat_smooth()` provides the following variables, some of +#' which depend on the orientation:", +#' "y|x" = "Predicted value.", +#' "ymin|xmin" = "Lower pointwise confidence band around the mean.", +#' "ymax|xmax" = "Upper pointwise confidence band around the mean.", +#' "se" = "Standard error." +#' ) +#' @export +#' @rdname geom_smooth +stat_smooth <- make_constructor(StatSmooth, geom = "smooth", orientation = NA) + # This function exists to silence an undeclared import warning gam_method <- function() { if (is_installed("mgcv")) { diff --git a/R/stat-sum.R b/R/stat-sum.R index 0dff7c07f2..a9529e6357 100644 --- a/R/stat-sum.R +++ b/R/stat-sum.R @@ -1,37 +1,9 @@ -#' @inheritParams layer -#' @inheritParams geom_point -#' @eval rd_computed_vars( -#' n = "Number of observations at position.", -#' prop = "Percent of points in that panel at that position." -#' ) -#' @export -#' @rdname geom_count -stat_sum <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatSum, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatSum <- ggproto("StatSum", Stat, +StatSum <- ggproto( + "StatSum", Stat, default_aes = aes(size = after_stat(n), weight = 1), required_aes = c("x", "y"), @@ -47,3 +19,13 @@ StatSum <- ggproto("StatSum", Stat, counts } ) + +#' @inheritParams layer +#' @inheritParams geom_point +#' @eval rd_computed_vars( +#' n = "Number of observations at position.", +#' prop = "Percent of points in that panel at that position." +#' ) +#' @export +#' @rdname geom_count +stat_sum <- make_constructor(StatSum, geom = "point") diff --git a/R/stat-summary-2d.R b/R/stat-summary-2d.R index 41d0c5b588..f675d81adc 100644 --- a/R/stat-summary-2d.R +++ b/R/stat-summary-2d.R @@ -1,93 +1,9 @@ -#' Bin and summarise in 2d (rectangle & hexagons) -#' -#' `stat_summary_2d()` is a 2d variation of [stat_summary()]. -#' `stat_summary_hex()` is a hexagonal variation of -#' [stat_summary_2d()]. The data are divided into bins defined -#' by `x` and `y`, and then the values of `z` in each cell is -#' are summarised with `fun`. -#' -#' @section Aesthetics: -#' - `x`: horizontal position -#' - `y`: vertical position -#' - `z`: value passed to the summary function -#' -#' @eval rd_computed_vars( -#' "x,y" = "Location.", -#' value = "Value of summary statistic." -#' ) -#' -#' @section Dropped variables: -#' \describe{ -#' \item{`z`}{After binning, the z values of individual data points are no longer available.} -#' } -#' @seealso [stat_summary_hex()] for hexagonal summarization. -#' [stat_bin_2d()] for the binning options. -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams stat_bin_2d -#' @param drop drop if the output of `fun` is `NA`. -#' @param fun function for summary. -#' @param fun.args A list of extra arguments to pass to `fun` -#' @inheritSection stat_bin_2d Controlling binning parameters for the x and y directions -#' @export -#' @examples -#' d <- ggplot(diamonds, aes(carat, depth, z = price)) -#' d + stat_summary_2d() -#' -#' # Specifying function -#' d + stat_summary_2d(fun = function(x) sum(x^2)) -#' d + stat_summary_2d(fun = ~ sum(.x^2)) -#' d + stat_summary_2d(fun = var) -#' d + stat_summary_2d(fun = "quantile", fun.args = list(probs = 0.1)) -#' -#' if (requireNamespace("hexbin")) { -#' d + stat_summary_hex() -#' d + stat_summary_hex(fun = ~ sum(.x^2)) -#' } -stat_summary_2d <- function(mapping = NULL, data = NULL, - geom = "tile", position = "identity", - ..., - bins = 30, - binwidth = NULL, - drop = TRUE, - fun = "mean", - fun.args = list(), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatSummary2d, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - drop = drop, - fun = fun, - fun.args = fun.args, - na.rm = na.rm, - ... - ) - ) -} - -#' @export -#' @rdname stat_summary_2d -#' @usage NULL -stat_summary2d <- function(...) { - cli::cli_inform("Please use {.fn stat_summary_2d} instead") - stat_summary_2d(...) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatSummary2d <- ggproto("StatSummary2d", Stat, +StatSummary2d <- ggproto( + "StatSummary2d", Stat, default_aes = aes(fill = after_stat(value)), required_aes = c("x", "y", "z"), @@ -107,8 +23,10 @@ StatSummary2d <- ggproto("StatSummary2d", Stat, params }, + extra_params = c("na.rm", "origin"), + compute_group = function(data, scales, binwidth = NULL, bins = 30, - breaks = NULL, origin = NULL, drop = TRUE, + breaks = NULL, drop = TRUE, fun = "mean", fun.args = list(), boundary = 0, closed = NULL, center = NULL) { bins <- dual_param(bins, list(x = 30, y = 30)) @@ -144,6 +62,62 @@ StatSummary2d <- ggproto("StatSummary2d", Stat, } ) +#' Bin and summarise in 2d (rectangle & hexagons) +#' +#' `stat_summary_2d()` is a 2d variation of [stat_summary()]. +#' `stat_summary_hex()` is a hexagonal variation of +#' [stat_summary_2d()]. The data are divided into bins defined +#' by `x` and `y`, and then the values of `z` in each cell is +#' are summarised with `fun`. +#' +#' @section Aesthetics: +#' - `x`: horizontal position +#' - `y`: vertical position +#' - `z`: value passed to the summary function +#' +#' @eval rd_computed_vars( +#' "x,y" = "Location.", +#' value = "Value of summary statistic." +#' ) +#' +#' @section Dropped variables: +#' \describe{ +#' \item{`z`}{After binning, the z values of individual data points are no longer available.} +#' } +#' @seealso [stat_summary_hex()] for hexagonal summarization. +#' [stat_bin_2d()] for the binning options. +#' @inheritParams layer +#' @inheritParams geom_point +#' @inheritParams stat_bin_2d +#' @param drop drop if the output of `fun` is `NA`. +#' @param fun function for summary. +#' @param fun.args A list of extra arguments to pass to `fun` +#' @inheritSection stat_bin_2d Controlling binning parameters for the x and y directions +#' @export +#' @examples +#' d <- ggplot(diamonds, aes(carat, depth, z = price)) +#' d + stat_summary_2d() +#' +#' # Specifying function +#' d + stat_summary_2d(fun = function(x) sum(x^2)) +#' d + stat_summary_2d(fun = ~ sum(.x^2)) +#' d + stat_summary_2d(fun = var) +#' d + stat_summary_2d(fun = "quantile", fun.args = list(probs = 0.1)) +#' +#' if (requireNamespace("hexbin")) { +#' d + stat_summary_hex() +#' d + stat_summary_hex(fun = ~ sum(.x^2)) +#' } +stat_summary_2d <- make_constructor(StatSummary2d, geom = "tile") + +#' @export +#' @rdname stat_summary_2d +#' @usage NULL +stat_summary2d <- function(...) { + cli::cli_inform("Please use {.fn stat_summary_2d} instead") + stat_summary_2d(...) +} + # Adaptation of tapply that returns a data frame instead of a matrix tapply_df <- function(x, index, fun, ..., drop = TRUE) { labels <- lapply(index, ulevels, na.last = NA) # drop NA diff --git a/R/stat-summary-hex.R b/R/stat-summary-hex.R index 959630b4ac..8ba4071ef2 100644 --- a/R/stat-summary-hex.R +++ b/R/stat-summary-hex.R @@ -1,42 +1,9 @@ -#' @export -#' @rdname stat_summary_2d -#' @inheritParams stat_bin_hex -stat_summary_hex <- function(mapping = NULL, data = NULL, - geom = "hex", position = "identity", - ..., - bins = 30, - binwidth = NULL, - drop = TRUE, - fun = "mean", - fun.args = list(), - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatSummaryHex, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bins = bins, - binwidth = binwidth, - drop = drop, - fun = fun, - fun.args = fun.args, - na.rm = na.rm, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatSummaryHex <- ggproto("StatSummaryHex", Stat, +StatSummaryHex <- ggproto( + "StatSummaryHex", Stat, default_aes = aes(fill = after_stat(value)), required_aes = c("x", "y", "z"), @@ -50,6 +17,11 @@ StatSummaryHex <- ggproto("StatSummaryHex", Stat, binwidth <- binwidth %||% hex_binwidth(bins, scales) fun <- as_function(fun) hexBinSummarise(data$x, data$y, data$z, binwidth, - fun = fun, fun.args = fun.args, drop = drop) + fun = fun, fun.args = fun.args, drop = drop) } ) + +#' @export +#' @rdname stat_summary_2d +#' @inheritParams stat_bin_hex +stat_summary_hex <- make_constructor(StatSummaryHex, geom = "hex") diff --git a/R/stat-unique.R b/R/stat-unique.R index 38483a2d7b..160875c733 100644 --- a/R/stat-unique.R +++ b/R/stat-unique.R @@ -1,3 +1,12 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +StatUnique <- ggproto( + "StatUnique", Stat, + compute_panel = function(data, scales) unique0(data) +) + #' Remove duplicates #' #' @eval rd_aesthetics("stat", "unique") @@ -9,31 +18,4 @@ #' geom_point(alpha = 0.1) #' ggplot(mtcars, aes(vs, am)) + #' geom_point(alpha = 0.1, stat = "unique") -stat_unique <- function(mapping = NULL, data = NULL, - geom = "point", position = "identity", - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatUnique, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -StatUnique <- ggproto("StatUnique", Stat, - compute_panel = function(data, scales) unique0(data) -) +stat_unique <- make_constructor(StatUnique, geom = "point") diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 6b0e4f0ff8..3782edafcb 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -1,77 +1,9 @@ -#' @inheritParams layer -#' @inheritParams geom_point -#' @inheritParams stat_density -#' @param scale if "area" (default), all violins have the same area (before trimming -#' the tails). If "count", areas are scaled proportionally to the number of -#' observations. If "width", all violins have the same maximum width. -#' @param drop Whether to discard groups with less than 2 observations -#' (`TRUE`, default) or keep such groups for position adjustment purposes -#' (`FALSE`). -#' @param quantiles If not `NULL` (default), compute the `quantile` variable -#' and draw horizontal lines at the given quantiles in `geom_violin()`. -#' -#' @eval rd_computed_vars( -#' density = "Density estimate.", -#' scaled = "Density estimate, scaled to a maximum of 1.", -#' count = "Density * number of points - probably useless for violin -#' plots.", -#' violinwidth = "Density scaled for the violin plot, according to area, -#' counts or to a constant maximum width.", -#' n = "Number of points.", -#' width = "Width of violin bounding box.", -#' quantile = "Whether the row is part of the `quantiles` computation." -#' ) -#' -#' @seealso [geom_violin()] for examples, and [stat_density()] -#' for examples with data along the x axis. -#' @export -#' @rdname geom_violin -stat_ydensity <- function(mapping = NULL, data = NULL, - geom = "violin", position = "dodge", - ..., - quantiles = c(0.25, 0.50, 0.75), - bw = "nrd0", - adjust = 1, - kernel = "gaussian", - trim = TRUE, - scale = "area", - drop = TRUE, - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE, - bounds = c(-Inf, Inf)) { - scale <- arg_match0(scale, c("area", "count", "width")) - - layer( - data = data, - mapping = mapping, - stat = StatYdensity, - geom = geom, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - bw = bw, - adjust = adjust, - kernel = kernel, - trim = trim, - scale = scale, - drop = drop, - na.rm = na.rm, - bounds = bounds, - quantiles = quantiles, - ... - ) - ) -} - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL #' @export -StatYdensity <- ggproto("StatYdensity", Stat, +StatYdensity <- ggproto( + "StatYdensity", Stat, required_aes = c("x", "y"), non_missing_aes = "weight", @@ -95,9 +27,9 @@ StatYdensity <- ggproto("StatYdensity", Stat, extra_params = c("na.rm", "orientation", "draw_quantiles"), compute_group = function(self, data, scales, width = NULL, bw = "nrd0", adjust = 1, - kernel = "gaussian", trim = TRUE, na.rm = FALSE, - drop = TRUE, flipped_aes = FALSE, bounds = c(-Inf, Inf), - quantiles = c(0.25, 0.50, 0.75)) { + kernel = "gaussian", trim = TRUE, na.rm = FALSE, + drop = TRUE, flipped_aes = FALSE, bounds = c(-Inf, Inf), + quantiles = c(0.25, 0.50, 0.75)) { if (nrow(data) < 2) { if (isTRUE(drop)) { cli::cli_warn(c( @@ -105,7 +37,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, i = paste0( "Set {.code drop = FALSE} to consider such groups for position ", "adjustment purposes." - ))) + ))) return(data_frame0()) } ans <- data_frame0(x = data$x, n = nrow(data)) @@ -178,15 +110,15 @@ StatYdensity <- ggproto("StatYdensity", Stat, # choose how violins are scaled relative to each other data$violinwidth <- switch(scale, - # area : keep the original densities but scale them to a max width of 1 - # for plotting purposes only - area = data$density / max(data$density, na.rm = TRUE), - # count: use the original densities scaled to a maximum of 1 (as above) - # and then scale them according to the number of observations - count = data$density / max(data$density, na.rm = TRUE) * - data$n / max(data$n), - # width: constant width (density scaled to a maximum of 1) - width = data$scaled + # area : keep the original densities but scale them to a max width of 1 + # for plotting purposes only + area = data$density / max(data$density, na.rm = TRUE), + # count: use the original densities scaled to a maximum of 1 (as above) + # and then scale them according to the number of observations + count = data$density / max(data$density, na.rm = TRUE) * + data$n / max(data$n), + # width: constant width (density scaled to a maximum of 1) + width = data$scaled ) data$flipped_aes <- flipped_aes flip_data(data, flipped_aes) @@ -195,6 +127,40 @@ StatYdensity <- ggproto("StatYdensity", Stat, dropped_aes = "weight" ) +#' @inheritParams layer +#' @inheritParams geom_point +#' @inheritParams stat_density +#' @param scale if "area" (default), all violins have the same area (before trimming +#' the tails). If "count", areas are scaled proportionally to the number of +#' observations. If "width", all violins have the same maximum width. +#' @param drop Whether to discard groups with less than 2 observations +#' (`TRUE`, default) or keep such groups for position adjustment purposes +#' (`FALSE`). +#' @param quantiles If not `NULL` (default), compute the `quantile` variable +#' and draw horizontal lines at the given quantiles in `geom_violin()`. +#' +#' @eval rd_computed_vars( +#' density = "Density estimate.", +#' scaled = "Density estimate, scaled to a maximum of 1.", +#' count = "Density * number of points - probably useless for violin +#' plots.", +#' violinwidth = "Density scaled for the violin plot, according to area, +#' counts or to a constant maximum width.", +#' n = "Number of points.", +#' width = "Width of violin bounding box.", +#' quantile = "Whether the row is part of the `quantiles` computation." +#' ) +#' +#' @seealso [geom_violin()] for examples, and [stat_density()] +#' for examples with data along the x axis. +#' @export +#' @rdname geom_violin +stat_ydensity <- make_constructor( + StatYdensity, geom = "violin", position = "dodge", + checks = exprs(scale <- arg_match0(scale, c("area", "count", "width"))), + orientation = NA, omit = "width" +) + calc_bw <- function(x, bw) { if (is.character(bw)) { if (length(x) < 2) { diff --git a/man/borders.Rd b/man/borders.Rd index 2f5e9f6841..76a709345e 100644 --- a/man/borders.Rd +++ b/man/borders.Rd @@ -29,6 +29,9 @@ polygons, see \code{\link[maps:map]{maps::map()}} for details.} \item{...}{ Arguments passed on to \code{\link[=geom_polygon]{geom_polygon}} \describe{ + \item{\code{lineend}}{Line end style (round, butt, square).} + \item{\code{linejoin}}{Line join style (round, mitre, bevel).} + \item{\code{linemitre}}{Line mitre limit (number greater than 1).} \item{\code{rule}}{Either \code{"evenodd"} or \code{"winding"}. If polygons with holes are being drawn (using the \code{subgroup} aesthetic) this argument defines how the hole coordinates are interpreted. See the examples in \code{\link[grid:grid.path]{grid::pathGrob()}} for diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index 6c8c67cc19..45d5666759 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -13,8 +13,9 @@ geom_bar( position = "stack", ..., just = 0.5, + lineend = "butt", + linejoin = "mitre", na.rm = FALSE, - orientation = NA, show.legend = NA, inherit.aes = TRUE ) @@ -22,9 +23,12 @@ geom_bar( geom_col( mapping = NULL, data = NULL, + stat = "identity", position = "stack", ..., just = 0.5, + lineend = "butt", + linejoin = "mitre", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -36,8 +40,8 @@ stat_count( geom = "bar", position = "stack", ..., - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -110,14 +114,13 @@ columns to the left/right of axis breaks. Note that this argument may have unintended behaviour when used with alternative positions, e.g. \code{position_dodge()}.} +\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{orientation}{The orientation of the layer. The default (\code{NA}) -automatically determines the orientation from the aesthetic mapping. In the -rare event that this fails it can be given explicitly by setting \code{orientation} -to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} - \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. @@ -134,6 +137,11 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} \item{geom, stat}{Override the default connection between \code{geom_bar()} and \code{stat_count()}. For more information about overriding these connections, see how the \link[=layer_stats]{stat} and \link[=layer_geoms]{geom} arguments work.} + +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} } \description{ There are two types of bar charts: \code{geom_bar()} and \code{geom_col()}. diff --git a/man/geom_bin_2d.Rd b/man/geom_bin_2d.Rd index dc0b9ce082..06e0c1f7e4 100644 --- a/man/geom_bin_2d.Rd +++ b/man/geom_bin_2d.Rd @@ -13,6 +13,8 @@ geom_bin_2d( stat = "bin2d", position = "identity", ..., + lineend = "butt", + linejoin = "mitre", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -24,12 +26,13 @@ stat_bin_2d( geom = "tile", position = "identity", ..., - bins = 30, binwidth = NULL, - center = NULL, - boundary = NULL, + bins = 30, breaks = NULL, drop = TRUE, + boundary = NULL, + closed = NULL, + center = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -97,6 +100,10 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\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.} @@ -118,8 +125,6 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} these connections, see how the \link[=layer_stats]{stat} and \link[=layer_geoms]{geom} arguments work.} -\item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} - \item{binwidth}{The width of the bins. Can be specified as a numeric value or as a function that takes x after scale transformation as input and returns a single numeric value. When specifying a function along with a @@ -132,6 +137,17 @@ stories in your data. The bin width of a date variable is the number of days in each time; the bin width of a time variable is the number of seconds.} +\item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} + +\item{breaks}{Alternatively, you can supply a numeric vector giving +the bin boundaries. Overrides \code{binwidth}, \code{bins}, \code{center}, +and \code{boundary}. Can also be a function that takes group-wise values as input and returns bin boundaries.} + +\item{drop}{if \code{TRUE} removes all cells with 0 counts.} + +\item{closed}{One of \code{"right"} or \code{"left"} indicating whether right +or left edges of bins are included in the bin.} + \item{center, boundary}{bin position specifiers. Only one, \code{center} or \code{boundary}, may be specified for a single plot. \code{center} specifies the center of one of the bins. \code{boundary} specifies the boundary between two @@ -141,12 +157,6 @@ For example, to center on integers use \code{binwidth = 1} and \code{center = 0} if \code{0} is outside the range of the data. Alternatively, this same alignment can be specified with \code{binwidth = 1} and \code{boundary = 0.5}, even if \code{0.5} is outside the range of the data.} - -\item{breaks}{Alternatively, you can supply a numeric vector giving -the bin boundaries. Overrides \code{binwidth}, \code{bins}, \code{center}, -and \code{boundary}. Can also be a function that takes group-wise values as input and returns bin boundaries.} - -\item{drop}{if \code{TRUE} removes all cells with 0 counts.} } \description{ Divides the plane into rectangles, counts the number of cases in diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index 5760caa71a..8a60f060f8 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -51,9 +51,9 @@ stat_boxplot( geom = "boxplot", position = "dodge2", ..., + orientation = NA, coef = 1.5, na.rm = FALSE, - orientation = NA, show.legend = NA, inherit.aes = TRUE ) diff --git a/man/geom_contour.Rd b/man/geom_contour.Rd index c42aec41c9..97d03e3a04 100644 --- a/man/geom_contour.Rd +++ b/man/geom_contour.Rd @@ -16,6 +16,8 @@ geom_contour( bins = NULL, binwidth = NULL, breaks = NULL, + arrow = NULL, + arrow.fill = NULL, lineend = "butt", linejoin = "round", linemitre = 10, @@ -33,6 +35,10 @@ geom_contour_filled( bins = NULL, binwidth = NULL, breaks = NULL, + rule = "evenodd", + lineend = "butt", + linejoin = "round", + linemitre = 10, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -156,6 +162,11 @@ and returns breaks as output. A function can be created from a formula Overrides \code{binwidth} and \code{bins}. By default, this is a vector of length ten with \code{\link[=pretty]{pretty()}} breaks.} +\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} +means use \code{colour} aesthetic.} + \item{lineend}{Line end style (round, butt, square).} \item{linejoin}{Line join style (round, mitre, bevel).} @@ -178,6 +189,11 @@ 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()}}.} +\item{rule}{Either \code{"evenodd"} or \code{"winding"}. If polygons with holes are +being drawn (using the \code{subgroup} aesthetic) this argument defines how the +hole coordinates are interpreted. See the examples in \code{\link[grid:grid.path]{grid::pathGrob()}} for +an explanation.} + \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The diff --git a/man/geom_density.Rd b/man/geom_density.Rd index 58f6dae9e2..4a2858b2a1 100644 --- a/man/geom_density.Rd +++ b/man/geom_density.Rd @@ -11,11 +11,13 @@ geom_density( stat = "density", position = "identity", ..., + lineend = "butt", + linejoin = "round", + linemitre = 10, + outline.type = "both", na.rm = FALSE, - orientation = NA, show.legend = NA, - inherit.aes = TRUE, - outline.type = "upper" + inherit.aes = TRUE ) stat_density( @@ -24,14 +26,14 @@ stat_density( geom = "area", position = "stack", ..., + orientation = NA, bw = "nrd0", adjust = 1, kernel = "gaussian", n = 512, trim = FALSE, - na.rm = FALSE, bounds = c(-Inf, Inf), - orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -98,14 +100,19 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + +\item{outline.type}{Type of the outline of the area; \code{"both"} draws both the +upper and lower lines, \code{"upper"}/\code{"lower"} draws the respective lines only. +\code{"full"} draws a closed polygon around the area.} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} -\item{orientation}{The orientation of the layer. The default (\code{NA}) -automatically determines the orientation from the aesthetic mapping. In the -rare event that this fails it can be given explicitly by setting \code{orientation} -to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} - \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. @@ -119,15 +126,16 @@ 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()}}.} -\item{outline.type}{Type of the outline of the area; \code{"both"} draws both the -upper and lower lines, \code{"upper"}/\code{"lower"} draws the respective lines only. -\code{"full"} draws a closed polygon around the area.} - \item{geom, stat}{Use to override the default connection between \code{geom_density()} and \code{stat_density()}. For more information about overriding these connections, see how the \link[=layer_stats]{stat} and \link[=layer_geoms]{geom} arguments work.} +\item{orientation}{The orientation of the layer. The default (\code{NA}) +automatically determines the orientation from the aesthetic mapping. In the +rare event that this fails it can be given explicitly by setting \code{orientation} +to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} + \item{bw}{The smoothing bandwidth to be used. If numeric, the standard deviation of the smoothing kernel. If character, a rule to choose the bandwidth, as listed in diff --git a/man/geom_density_2d.Rd b/man/geom_density_2d.Rd index f063cfdd4a..38eb2027ef 100644 --- a/man/geom_density_2d.Rd +++ b/man/geom_density_2d.Rd @@ -46,9 +46,9 @@ stat_density_2d( ..., contour = TRUE, contour_var = "density", - n = 100, h = NULL, adjust = c(1, 1), + n = 100, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -62,9 +62,9 @@ stat_density_2d_filled( ..., contour = TRUE, contour_var = "density", - n = 100, h = NULL, adjust = c(1, 1), + n = 100, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -155,8 +155,6 @@ overriding these connections, see how the \link[=layer_stats]{stat} and \item{contour}{If \code{TRUE}, contour the results of the 2d density estimation.} -\item{n}{Number of grid points in each direction.} - \item{h}{Bandwidth (vector of length two). If \code{NULL}, estimated using \code{\link[MASS:bandwidth.nrd]{MASS::bandwidth.nrd()}}.} @@ -164,6 +162,8 @@ using \code{\link[MASS:bandwidth.nrd]{MASS::bandwidth.nrd()}}.} 'NULL'. This makes it possible to adjust the bandwidth while still using the a bandwidth estimator. For example, \code{adjust = 1/2} means use half of the default bandwidth.} + +\item{n}{Number of grid points in each direction.} } \description{ Perform a 2D kernel density estimation using \code{\link[MASS:kde2d]{MASS::kde2d()}} and diff --git a/man/geom_function.Rd b/man/geom_function.Rd index faf9d8552e..8ce29f0daa 100644 --- a/man/geom_function.Rd +++ b/man/geom_function.Rd @@ -11,6 +11,11 @@ geom_function( stat = "function", position = "identity", ..., + arrow = NULL, + arrow.fill = NULL, + lineend = "butt", + linejoin = "round", + linemitre = 10, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -93,6 +98,17 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} +means use \code{colour} aesthetic.} + +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} diff --git a/man/geom_hex.Rd b/man/geom_hex.Rd index da103b0e3c..f6d9210b54 100644 --- a/man/geom_hex.Rd +++ b/man/geom_hex.Rd @@ -12,6 +12,9 @@ geom_hex( stat = "binhex", position = "identity", ..., + lineend = "butt", + linejoin = "mitre", + linemitre = 10, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -23,8 +26,8 @@ stat_bin_hex( geom = "hex", position = "identity", ..., - bins = 30, binwidth = NULL, + bins = 30, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -92,6 +95,12 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} @@ -112,8 +121,6 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} \code{stat_bin_hex()}. For more information about overriding these connections, see how the \link[=layer_stats]{stat} and \link[=layer_geoms]{geom} arguments work.} -\item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} - \item{binwidth}{The width of the bins. Can be specified as a numeric value or as a function that takes x after scale transformation as input and returns a single numeric value. When specifying a function along with a @@ -125,6 +132,8 @@ stories in your data. The bin width of a date variable is the number of days in each time; the bin width of a time variable is the number of seconds.} + +\item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} } \description{ Divides the plane into regular hexagons, counts the number of cases in diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index 0a27e87c10..b2f7c1afbd 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -26,8 +26,10 @@ geom_histogram( ..., binwidth = NULL, bins = NULL, - na.rm = FALSE, orientation = NA, + lineend = "butt", + linejoin = "mitre", + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -38,16 +40,16 @@ stat_bin( geom = "bar", position = "stack", ..., + orientation = NA, binwidth = NULL, bins = NULL, center = NULL, boundary = NULL, - breaks = NULL, closed = c("right", "left"), pad = FALSE, - na.rm = FALSE, + breaks = NULL, drop = "all", - orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -149,6 +151,10 @@ automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + \item{geom, stat}{Use to override the default connection between \code{geom_histogram()}/\code{geom_freqpoly()} and \code{stat_bin()}. For more information at overriding these connections, see how the \link[=layer_stats]{stat} and @@ -164,16 +170,16 @@ if \code{0} is outside the range of the data. Alternatively, this same alignment can be specified with \code{binwidth = 1} and \code{boundary = 0.5}, even if \code{0.5} is outside the range of the data.} -\item{breaks}{Alternatively, you can supply a numeric vector giving -the bin boundaries. Overrides \code{binwidth}, \code{bins}, \code{center}, -and \code{boundary}. Can also be a function that takes group-wise values as input and returns bin boundaries.} - \item{closed}{One of \code{"right"} or \code{"left"} indicating whether right or left edges of bins are included in the bin.} \item{pad}{If \code{TRUE}, adds empty bins at either end of x. This ensures frequency polygons touch 0. Defaults to \code{FALSE}.} +\item{breaks}{Alternatively, you can supply a numeric vector giving +the bin boundaries. Overrides \code{binwidth}, \code{bins}, \code{center}, +and \code{boundary}. Can also be a function that takes group-wise values as input and returns bin boundaries.} + \item{drop}{Treatment of zero count bins. If \code{"all"} (default), such bins are kept as-is. If \code{"none"}, all zero count bins are filtered out. If \code{"inner"} only zero count bins at the flanks are filtered out, but not diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 0c77084236..f0a3cd30b3 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -36,32 +36,24 @@ geom_errorbar( stat = "identity", position = "identity", ..., - na.rm = FALSE, orientation = NA, - show.legend = NA, - inherit.aes = TRUE -) - -geom_errorbarh( - mapping = NULL, - data = NULL, - stat = "identity", - position = "identity", - ..., - orientation = "y", + lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) +geom_errorbarh(..., orientation = "y") + geom_linerange( mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., - na.rm = FALSE, orientation = NA, + lineend = "butt", + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -72,9 +64,10 @@ geom_pointrange( stat = "identity", position = "identity", ..., + orientation = NA, fatten = deprecated(), + lineend = "butt", na.rm = FALSE, - orientation = NA, show.legend = NA, inherit.aes = TRUE ) @@ -184,6 +177,8 @@ but unobserved levels are omitted.} 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()}}.} + +\item{lineend}{Line end style (round, butt, square).} } \description{ Various ways of representing a vertical interval defined by \code{x}, diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 88913a5a7b..b5b4def14c 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -12,11 +12,11 @@ geom_path( stat = "identity", position = "identity", ..., + arrow = NULL, + arrow.fill = NULL, lineend = "butt", linejoin = "round", linemitre = 10, - arrow = NULL, - arrow.fill = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -27,11 +27,16 @@ geom_line( data = NULL, stat = "identity", position = "identity", - na.rm = FALSE, + ..., orientation = NA, + arrow = NULL, + arrow.fill = NULL, + lineend = "butt", + linejoin = "round", + linemitre = 10, + na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, - ... + inherit.aes = TRUE ) geom_step( @@ -39,12 +44,17 @@ geom_step( data = NULL, stat = "identity", position = "identity", + ..., + orientation = NA, + lineend = "butt", + linejoin = "round", + linemitre = 10, + arrow = NULL, + arrow.fill = NULL, direction = "hv", na.rm = FALSE, - orientation = NA, show.legend = NA, - inherit.aes = TRUE, - ... + inherit.aes = TRUE ) } \arguments{ @@ -122,17 +132,17 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} +means use \code{colour} aesthetic.} + \item{lineend}{Line end style (round, butt, square).} \item{linejoin}{Line join style (round, mitre, bevel).} \item{linemitre}{Line mitre limit (number greater than 1).} -\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} - -\item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} -means use \code{colour} aesthetic.} - \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} diff --git a/man/geom_polygon.Rd b/man/geom_polygon.Rd index 241490284a..e1f40f6c1a 100644 --- a/man/geom_polygon.Rd +++ b/man/geom_polygon.Rd @@ -9,8 +9,11 @@ geom_polygon( data = NULL, stat = "identity", position = "identity", - rule = "evenodd", ..., + rule = "evenodd", + lineend = "butt", + linejoin = "round", + linemitre = 10, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -63,11 +66,6 @@ to use \code{position_jitter()}, give the position as \code{"jitter"}. \link[=layer_positions]{layer position} documentation. }} -\item{rule}{Either \code{"evenodd"} or \code{"winding"}. If polygons with holes are -being drawn (using the \code{subgroup} aesthetic) this argument defines how the -hole coordinates are interpreted. See the examples in \code{\link[grid:grid.path]{grid::pathGrob()}} for -an explanation.} - \item{...}{Other arguments passed on to \code{\link[=layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required @@ -96,6 +94,17 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{rule}{Either \code{"evenodd"} or \code{"winding"}. If polygons with holes are +being drawn (using the \code{subgroup} aesthetic) this argument defines how the +hole coordinates are interpreted. See the examples in \code{\link[grid:grid.path]{grid::pathGrob()}} for +an explanation.} + +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} @@ -197,7 +206,6 @@ if (packageVersion("grid") >= "3.6") { geom_polygon(aes(fill = value, group = id, subgroup = subid)) p } - } \seealso{ \code{\link[=geom_path]{geom_path()}} for an unfilled polygon, diff --git a/man/geom_quantile.Rd b/man/geom_quantile.Rd index 568c33e970..3109da63b1 100644 --- a/man/geom_quantile.Rd +++ b/man/geom_quantile.Rd @@ -11,6 +11,8 @@ geom_quantile( stat = "quantile", position = "identity", ..., + arrow = NULL, + arrow.fill = NULL, lineend = "butt", linejoin = "round", linemitre = 10, @@ -96,6 +98,11 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} +means use \code{colour} aesthetic.} + \item{lineend}{Line end style (round, butt, square).} \item{linejoin}{Line join style (round, mitre, bevel).} diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index d4f5a707e1..fcb79eb209 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -12,11 +12,14 @@ geom_ribbon( stat = "identity", position = "identity", ..., - na.rm = FALSE, orientation = NA, + lineend = "butt", + linejoin = "round", + linemitre = 10, + outline.type = "both", + na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, - outline.type = "both" + inherit.aes = TRUE ) geom_area( @@ -24,12 +27,15 @@ geom_area( data = NULL, stat = "align", position = "stack", - na.rm = FALSE, + ..., orientation = NA, + outline.type = "upper", + lineend = "butt", + linejoin = "round", + linemitre = 10, + na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, - ..., - outline.type = "upper" + inherit.aes = TRUE ) stat_align( @@ -118,14 +124,24 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} -\item{na.rm}{If \code{FALSE}, the default, missing values are removed with -a warning. If \code{TRUE}, missing values are silently removed.} - \item{orientation}{The orientation of the layer. The default (\code{NA}) automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + +\item{outline.type}{Type of the outline of the area; \code{"both"} draws both the +upper and lower lines, \code{"upper"}/\code{"lower"} draws the respective lines only. +\code{"full"} draws a closed polygon around the area.} + +\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. @@ -139,10 +155,6 @@ 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()}}.} -\item{outline.type}{Type of the outline of the area; \code{"both"} draws both the -upper and lower lines, \code{"upper"}/\code{"lower"} draws the respective lines only. -\code{"full"} draws a closed polygon around the area.} - \item{geom}{The geometric object to use to display the data for this layer. When using a \verb{stat_*()} function to construct a layer, the \code{geom} argument can be used to override the default coupling between stats and geoms. The @@ -231,6 +243,7 @@ a + geom_point(stat = "align", position = "stack", size = 8) # To turn off the alignment, the stat can be set to "identity" ggplot(df, aes(x, y, fill = g)) + geom_area(stat = "identity") + } \seealso{ \code{\link[=geom_bar]{geom_bar()}} for discrete intervals (bars), diff --git a/man/geom_rug.Rd b/man/geom_rug.Rd index b6508c7f9a..17dc5b9c00 100644 --- a/man/geom_rug.Rd +++ b/man/geom_rug.Rd @@ -10,8 +10,9 @@ geom_rug( stat = "identity", position = "identity", ..., - outside = FALSE, + lineend = "butt", sides = "bl", + outside = FALSE, length = unit(0.03, "npc"), na.rm = FALSE, show.legend = NA, @@ -93,12 +94,14 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} -\item{outside}{logical that controls whether to move the rug tassels outside of the plot area. Default is off (FALSE). You will also need to use \code{coord_cartesian(clip = "off")}. When set to TRUE, also consider changing the sides argument to "tr". See examples.} +\item{lineend}{Line end style (round, butt, square).} \item{sides}{A string that controls which sides of the plot the rugs appear on. It can be set to a string containing any of \code{"trbl"}, for top, right, bottom, and left.} +\item{outside}{logical that controls whether to move the rug tassels outside of the plot area. Default is off (FALSE). You will also need to use \code{coord_cartesian(clip = "off")}. When set to TRUE, also consider changing the sides argument to "tr". See examples.} + \item{length}{A \code{\link[grid:unit]{grid::unit()}} object that sets the length of the rug lines. Use scale expansion to avoid overplotting of data.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with @@ -177,5 +180,4 @@ p + p + geom_rug(length = unit(0.05, "npc")) + scale_y_continuous(expand = c(0.1, 0.1)) - } diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index 6d89a61782..a8f72b34a7 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -26,6 +26,7 @@ stat_smooth( geom = "smooth", position = "identity", ..., + orientation = NA, method = NULL, formula = NULL, se = TRUE, @@ -36,7 +37,6 @@ stat_smooth( level = 0.95, method.args = list(), na.rm = FALSE, - orientation = NA, show.legend = NA, inherit.aes = TRUE ) diff --git a/man/geom_spoke.Rd b/man/geom_spoke.Rd index ea28f601c1..657333ac75 100644 --- a/man/geom_spoke.Rd +++ b/man/geom_spoke.Rd @@ -11,6 +11,10 @@ geom_spoke( stat = "identity", position = "identity", ..., + arrow = NULL, + arrow.fill = NULL, + lineend = "butt", + linejoin = "round", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -91,6 +95,15 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{arrow}{specification for arrow heads, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} +means use \code{colour} aesthetic.} + +\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.} diff --git a/man/geom_tile.Rd b/man/geom_tile.Rd index 34b9bb30bc..a09fd8b570 100644 --- a/man/geom_tile.Rd +++ b/man/geom_tile.Rd @@ -12,9 +12,9 @@ geom_raster( stat = "identity", position = "identity", ..., + interpolate = FALSE, hjust = 0.5, vjust = 0.5, - interpolate = FALSE, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -26,6 +26,7 @@ geom_rect( stat = "identity", position = "identity", ..., + lineend = "butt", linejoin = "mitre", na.rm = FALSE, show.legend = NA, @@ -38,6 +39,7 @@ geom_tile( stat = "identity", position = "identity", ..., + lineend = "butt", linejoin = "mitre", na.rm = FALSE, show.legend = NA, @@ -119,13 +121,13 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\item{interpolate}{If \code{TRUE} interpolate linearly, if \code{FALSE} +(the default) don't interpolate.} + \item{hjust, vjust}{horizontal and vertical justification of the grob. Each justification value should be a number between 0 and 1. Defaults to 0.5 for both, centering each pixel over its data location.} -\item{interpolate}{If \code{TRUE} interpolate linearly, if \code{FALSE} -(the default) don't interpolate.} - \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} @@ -142,6 +144,8 @@ 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()}}.} +\item{lineend}{Line end style (round, butt, square).} + \item{linejoin}{Line join style (round, mitre, bevel).} } \description{ diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 7b923b68ab..abf04337e8 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -31,18 +31,18 @@ stat_ydensity( geom = "violin", position = "dodge", ..., - quantiles = c(0.25, 0.5, 0.75), + orientation = NA, bw = "nrd0", adjust = 1, kernel = "gaussian", trim = TRUE, scale = "area", drop = TRUE, + bounds = c(-Inf, Inf), + quantiles = c(0.25, 0.5, 0.75), na.rm = FALSE, - orientation = NA, show.legend = NA, - inherit.aes = TRUE, - bounds = c(-Inf, Inf) + inherit.aes = TRUE ) } \arguments{ @@ -153,9 +153,6 @@ the default plot specification, e.g. \code{\link[=borders]{borders()}}.} overriding these connections, see how the \link[=layer_stats]{stat} and \link[=layer_geoms]{geom} arguments work.} -\item{quantiles}{If not \code{NULL} (default), compute the \code{quantile} variable -and draw horizontal lines at the given quantiles in \code{geom_violin()}.} - \item{bw}{The smoothing bandwidth to be used. If numeric, the standard deviation of the smoothing kernel. If character, a rule to choose the bandwidth, as listed in @@ -171,6 +168,9 @@ For example, \code{adjust = 1/2} means use half of the default bandwidth.} \item{drop}{Whether to discard groups with less than 2 observations (\code{TRUE}, default) or keep such groups for position adjustment purposes (\code{FALSE}).} + +\item{quantiles}{If not \code{NULL} (default), compute the \code{quantile} variable +and draw horizontal lines at the given quantiles in \code{geom_violin()}.} } \description{ A violin plot is a compact display of a continuous distribution. It is a diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 6658fdafb9..938333d3aa 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -7,10 +7,10 @@ % R/facet-.R, R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, % R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, R/geom-tile.R, R/geom-bin2d.R, % R/geom-blank.R, R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, -% R/geom-contour.R, R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, -% R/geom-ribbon.R, R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, -% R/geom-errorbar.R, R/geom-function.R, R/geom-hex.R, R/geom-hline.R, -% R/geom-label.R, R/geom-linerange.R, R/geom-point.R, R/geom-pointrange.R, +% R/geom-contour.R, R/geom-point.R, R/geom-crossbar.R, R/geom-segment.R, +% R/geom-curve.R, R/geom-ribbon.R, R/geom-density.R, R/geom-density2d.R, +% R/geom-dotplot.R, R/geom-errorbar.R, R/geom-function.R, R/geom-hex.R, +% R/geom-hline.R, R/geom-label.R, R/geom-linerange.R, R/geom-pointrange.R, % R/geom-quantile.R, R/geom-rug.R, R/geom-smooth.R, R/geom-spoke.R, % R/geom-text.R, R/geom-violin.R, R/geom-vline.R, R/guide-.R, R/guide-axis.R, % R/guide-axis-logticks.R, R/guide-axis-stack.R, R/guide-axis-theta.R, @@ -66,6 +66,7 @@ \alias{GeomStep} \alias{GeomContour} \alias{GeomContourFilled} +\alias{GeomPoint} \alias{GeomCrossbar} \alias{GeomSegment} \alias{GeomCurve} @@ -82,7 +83,6 @@ \alias{GeomHline} \alias{GeomLabel} \alias{GeomLinerange} -\alias{GeomPoint} \alias{GeomPointrange} \alias{GeomQuantile} \alias{GeomRug} diff --git a/man/is_tests.Rd b/man/is_tests.Rd index bcb7bf0683..8528ffba5e 100644 --- a/man/is_tests.Rd +++ b/man/is_tests.Rd @@ -1,18 +1,18 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ggproto.R, R/aes.R, R/geom-.R, R/coord-.R, -% R/facet-.R, R/stat-.R, R/theme-elements.R, R/guide-.R, R/layer.R, +% Please edit documentation in R/ggproto.R, R/aes.R, R/geom-.R, R/layer.R, +% R/coord-.R, R/facet-.R, R/stat-.R, R/theme-elements.R, R/guide-.R, % R/guides-.R, R/margins.R, R/plot.R, R/position-.R, R/scale-.R, R/theme.R \name{is.ggproto} \alias{is.ggproto} \alias{is.mapping} \alias{is.geom} +\alias{is.layer} \alias{is.coord} \alias{is.Coord} \alias{is.facet} \alias{is.stat} \alias{is.theme_element} \alias{is.guide} -\alias{is.layer} \alias{is.guides} \alias{is.margin} \alias{is_tests} @@ -28,6 +28,8 @@ is.mapping(x) is.geom(x) +is.layer(x) + is.coord(x) is.Coord(x) # Deprecated @@ -40,8 +42,6 @@ is.theme_element(x) is.guide(x) -is.layer(x) - is.guides(x) is.margin(x) diff --git a/man/make_constructor.Rd b/man/make_constructor.Rd new file mode 100644 index 0000000000..74f832c0a9 --- /dev/null +++ b/man/make_constructor.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/make-constructor.R +\name{make_constructor} +\alias{make_constructor} +\alias{make_constructor.Geom} +\alias{make_constructor.Stat} +\title{Produce boilerplate constructors} +\usage{ +make_constructor(x, ...) + +\method{make_constructor}{Geom}( + x, + ..., + checks = exprs(), + omit = character(), + env = caller_env() +) + +\method{make_constructor}{Stat}( + x, + ..., + checks = exprs(), + omit = character(), + env = caller_env() +) +} +\arguments{ +\item{x}{An object to setup a constructor for.} + +\item{...}{Name-value pairs to use as additional arguments in the +constructor. For layers, these are passed on to \code{\link[=layer]{layer(params)}}.} + +\item{checks}{A list of calls to be evaluated before construction of the +object, such as one constructed with \code{\link[rlang:defusing-advanced]{exprs()}}.} + +\item{omit}{A character vector of automatically retrieved argument names +that should not be converted to user-facing arguments. Useful for +internally computed variables.} + +\item{env}{An environment to search for the object.} +} +\value{ +A function +} +\description{ +The \code{make_constructor()} functions sets up a user-facing constructor for +ggproto classes. Currently, \code{make_constructor()} is implemented for +\code{Geom} classes. +} +\examples{ +# For testing purposes, a geom that returns grobs +GeomTest <- ggproto( + "GeomTest", Geom, + draw_group = function(..., grob = grid::pointsGrob()) { + return(grob) + } +) +# Creating a constructor +geom_test <- make_constructor(GeomTest) + +# Note that `grob` is automatically an argument to the function +names(formals(geom_test)) + +# Use in a plot +set.seed(1234) +p <- ggplot(mtcars, aes(disp, mpg)) +p + geom_test() +p + geom_test(grob = grid::circleGrob()) + +# The `checks` argument can be used to evaluate arbitrary expressions in +# the constructor before building the layer. +geom_path2 <- make_constructor( + GeomPath, checks = rlang::exprs( + match.arg(lineend, c("butt", "round", "square")), + match.arg(linejoin, c("round", "mitre", "bevel")) + ) +) + +# Note the inclusion of the expressions +print(geom_path2) + +# Argument mismatch is detected +try(geom_path2(linejoin = "foo")) +} +\keyword{internal} diff --git a/man/stat_identity.Rd b/man/stat_identity.Rd index f5dd6e1a5d..64ffa0d494 100644 --- a/man/stat_identity.Rd +++ b/man/stat_identity.Rd @@ -10,6 +10,7 @@ stat_identity( geom = "point", position = "identity", ..., + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -89,6 +90,9 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} +\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. diff --git a/man/stat_summary_2d.Rd b/man/stat_summary_2d.Rd index da62dd0a15..1bada514f9 100644 --- a/man/stat_summary_2d.Rd +++ b/man/stat_summary_2d.Rd @@ -12,11 +12,15 @@ stat_summary_2d( geom = "tile", position = "identity", ..., - bins = 30, binwidth = NULL, + bins = 30, + breaks = NULL, drop = TRUE, fun = "mean", fun.args = list(), + boundary = 0, + closed = NULL, + center = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -28,8 +32,8 @@ stat_summary_hex( geom = "hex", position = "identity", ..., - bins = 30, binwidth = NULL, + bins = 30, drop = TRUE, fun = "mean", fun.args = list(), @@ -113,8 +117,6 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} -\item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} - \item{binwidth}{The width of the bins. Can be specified as a numeric value or as a function that takes x after scale transformation as input and returns a single numeric value. When specifying a function along with a @@ -127,12 +129,31 @@ stories in your data. The bin width of a date variable is the number of days in each time; the bin width of a time variable is the number of seconds.} +\item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} + +\item{breaks}{Alternatively, you can supply a numeric vector giving +the bin boundaries. Overrides \code{binwidth}, \code{bins}, \code{center}, +and \code{boundary}. Can also be a function that takes group-wise values as input and returns bin boundaries.} + \item{drop}{drop if the output of \code{fun} is \code{NA}.} \item{fun}{function for summary.} \item{fun.args}{A list of extra arguments to pass to \code{fun}} +\item{closed}{One of \code{"right"} or \code{"left"} indicating whether right +or left edges of bins are included in the bin.} + +\item{center, boundary}{bin position specifiers. Only one, \code{center} or +\code{boundary}, may be specified for a single plot. \code{center} specifies the +center of one of the bins. \code{boundary} specifies the boundary between two +bins. Note that if either is above or below the range of the data, things +will be shifted by the appropriate integer multiple of \code{binwidth}. +For example, to center on integers use \code{binwidth = 1} and \code{center = 0}, even +if \code{0} is outside the range of the data. Alternatively, this same alignment +can be specified with \code{binwidth = 1} and \code{boundary = 0.5}, even if \code{0.5} is +outside the range of the data.} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} diff --git a/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg b/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg index 5080746f6c..0e9b45a843 100644 --- a/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg +++ b/tests/testthat/_snaps/geom-polygon/open-and-closed-munched-polygons.svg @@ -32,8 +32,8 @@ colour - - + + closed open open and closed munched polygons diff --git a/tests/testthat/_snaps/position-stack/area-stacking.svg b/tests/testthat/_snaps/position-stack/area-stacking.svg index dea44df744..2629312a22 100644 --- a/tests/testthat/_snaps/position-stack/area-stacking.svg +++ b/tests/testthat/_snaps/position-stack/area-stacking.svg @@ -51,9 +51,9 @@ category - + - + A B Area stacking diff --git a/tests/testthat/_snaps/stat-align/align-two-areas-with-cliff.svg b/tests/testthat/_snaps/stat-align/align-two-areas-with-cliff.svg index abb667a819..2686f03715 100644 --- a/tests/testthat/_snaps/stat-align/align-two-areas-with-cliff.svg +++ b/tests/testthat/_snaps/stat-align/align-two-areas-with-cliff.svg @@ -53,9 +53,9 @@ g - + - + a b align two areas with cliff diff --git a/tests/testthat/_snaps/stat-align/align-two-areas-with-pos-neg-y.svg b/tests/testthat/_snaps/stat-align/align-two-areas-with-pos-neg-y.svg index 49be47a3ea..4cd5865e47 100644 --- a/tests/testthat/_snaps/stat-align/align-two-areas-with-pos-neg-y.svg +++ b/tests/testthat/_snaps/stat-align/align-two-areas-with-pos-neg-y.svg @@ -53,9 +53,9 @@ g - + - + a b align two areas with pos/neg y diff --git a/tests/testthat/_snaps/stat-align/align-two-areas.svg b/tests/testthat/_snaps/stat-align/align-two-areas.svg index 90186a513c..c123762358 100644 --- a/tests/testthat/_snaps/stat-align/align-two-areas.svg +++ b/tests/testthat/_snaps/stat-align/align-two-areas.svg @@ -53,9 +53,9 @@ g - + - + a b align two areas