From 5f067c156ed2f0c5cfda6d0df2baea0f0d89a49e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 16 Oct 2024 09:57:18 +0200 Subject: [PATCH 01/12] write boilerplate function --- DESCRIPTION | 5 ++-- R/boilerplates.R | 64 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 67 insertions(+), 2 deletions(-) create mode 100644 R/boilerplates.R diff --git a/DESCRIPTION b/DESCRIPTION index ff587e4b88..4c5b6a706a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -108,6 +108,9 @@ Collate: 'backports.R' 'bench.R' 'bin.R' + 'scale-type.R' + 'layer.R' + 'boilerplates.R' 'coord-.R' 'coord-cartesian-.R' 'coord-fixed.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/R/boilerplates.R b/R/boilerplates.R new file mode 100644 index 0000000000..26d8030aeb --- /dev/null +++ b/R/boilerplates.R @@ -0,0 +1,64 @@ +#' @include layer.R +#' @include scale-type.R +NULL + +#' @export +boilerplate <- function(x, ...) { + UseMethod("boilerplate") +} + +#' @export +boilerplate.Geom <- function(x, ..., env = caller_env()) { + + # Check that we can independently find the geom + geom <- gsub("^geom_", "", snake_class(x)) + check_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.") + } + + # Build function formals + fmls <- list2( + mapping = args$mapping, + data = args$data, + stat = args$stat %||% "identity", + position = args$position %||% "identity", + `...` = quote(expr = ), + !!!args[extra_args], + na.rm = args$na.rm %||% FALSE, + show.legend = args$show.legend %||% NA, + inherit.aes = args$inherit.aes %||% TRUE + ) + + if (length(extra_args) > 0) { + extra_args <- paste0( + "\n ", extra_args, " = ", extra_args, ",", collapse = "" + ) + } + + body <- paste0(" + layer( + data = data, + mapping = mapping, + stat = stat, + geom = \"", geom, "\", + position = position, + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list2( + na.rm = na.rm,", + extra_args, " + ... + ) + ) + ") + body <- as.call(parse(text = body))[[1]] + + new_function(fmls, body) +} From 32a4a763ef6d0d8859896a76e3c0be7ff01a39e6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 16 Oct 2024 11:20:26 +0200 Subject: [PATCH 02/12] adopt boilerplate where possible --- DESCRIPTION | 10 +- NAMESPACE | 2 + R/geom-bar.R | 110 ++++++-------- R/geom-bin2d.R | 25 +--- R/geom-col.R | 24 +-- R/geom-contour.R | 111 ++++---------- R/geom-count.R | 24 +-- R/geom-crossbar.R | 31 +--- R/geom-curve.R | 110 ++++++-------- R/geom-density.R | 25 ++-- R/geom-errorbar.R | 29 +--- R/geom-errorbarh.R | 76 ++++------ R/geom-hex.R | 86 ++++------- R/geom-histogram.R | 32 +--- R/geom-linerange.R | 110 ++++++-------- R/geom-path.R | 332 +++++++++++++++++------------------------ R/geom-point.R | 93 +++++------- R/geom-pointrange.R | 31 +--- R/geom-polygon.R | 187 +++++++++++------------ R/geom-quantile.R | 54 ++----- R/geom-rect.R | 29 +--- R/geom-rug.R | 142 ++++++++---------- R/geom-segment.R | 151 ++++++++----------- R/geom-smooth.R | 123 +++++++-------- R/geom-spoke.R | 56 +++---- R/geom-tile.R | 101 +++++-------- R/geom-violin.R | 216 ++++++++++++--------------- man/geom_bar.Rd | 9 +- man/geom_histogram.Rd | 2 +- man/geom_linerange.Rd | 14 +- man/geom_path.Rd | 12 +- man/geom_polygon.Rd | 13 +- man/geom_rug.Rd | 1 - man/geom_violin.Rd | 11 +- man/ggplot2-ggproto.Rd | 43 +++--- man/is_tests.Rd | 10 +- 36 files changed, 942 insertions(+), 1493 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4c5b6a706a..fad521e72d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -96,6 +96,9 @@ Collate: 'geom-.R' 'annotation-custom.R' 'annotation-logticks.R' + 'scale-type.R' + 'layer.R' + 'boilerplates.R' 'geom-polygon.R' 'geom-map.R' 'annotation-map.R' @@ -108,9 +111,6 @@ Collate: 'backports.R' 'bench.R' 'bin.R' - 'scale-type.R' - 'layer.R' - 'boilerplates.R' 'coord-.R' 'coord-cartesian-.R' 'coord-fixed.R' @@ -137,12 +137,14 @@ Collate: 'geom-abline.R' 'geom-rect.R' 'geom-bar.R' + 'geom-tile.R' 'geom-bin2d.R' 'geom-blank.R' 'geom-boxplot.R' 'geom-col.R' 'geom-path.R' 'geom-contour.R' + 'geom-point.R' 'geom-count.R' 'geom-crossbar.R' 'geom-segment.R' @@ -162,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' @@ -170,7 +171,6 @@ Collate: 'geom-smooth.R' 'geom-spoke.R' 'geom-text.R' - 'geom-tile.R' 'geom-violin.R' 'geom-vline.R' 'ggplot2-package.R' diff --git a/NAMESPACE b/NAMESPACE index 5737492a00..3b0b353c06 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,7 @@ S3method(as.data.frame,mapped_discrete) S3method(as.list,ggproto) S3method(autolayer,default) S3method(autoplot,default) +S3method(boilerplate,Geom) S3method(c,mapped_discrete) S3method(drawDetails,zeroGrob) S3method(element_grob,element_blank) @@ -297,6 +298,7 @@ export(autolayer) export(autoplot) export(benchplot) export(binned_scale) +export(boilerplate) export(borders) export(calc_element) export(check_device) diff --git a/R/geom-bar.R b/R/geom-bar.R index de7490bfc4..3027d02f53 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 = NULL), + + setup_params = function(data, params) { + params$flipped_aes <- has_flipped_aes(data, params) + params + }, + + extra_params = c("just", "na.rm", "orientation"), + + setup_data = function(data, params) { + data$flipped_aes <- params$flipped_aes + data <- flip_data(data, params$flipped_aes) + data$width <- data$width %||% + params$width %||% (min(vapply( + split(data$x, data$PANEL, drop = TRUE), + resolution, numeric(1), zero = FALSE + )) * 0.9) + 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 = TRUE +) + #' Bar charts #' #' There are two types of bar charts: `geom_bar()` and `geom_col()`. @@ -92,69 +134,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 = NULL), - - setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(data, params) - params - }, - - extra_params = c("just", "na.rm", "orientation"), - - setup_data = function(data, params) { - data$flipped_aes <- params$flipped_aes - data <- flip_data(data, params$flipped_aes) - data$width <- data$width %||% - params$width %||% (min(vapply( - split(data$x, data$PANEL, drop = TRUE), - resolution, numeric(1), zero = FALSE - )) * 0.9) - 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 = TRUE +geom_bar <- boilerplate( + GeomBar, stat = "count", position = "stack", + just = 0.5, orientation = NA ) diff --git a/R/geom-bin2d.R b/R/geom-bin2d.R index 2fe756dc96..1534b9a7ae 100644 --- a/R/geom-bin2d.R +++ b/R/geom-bin2d.R @@ -1,3 +1,6 @@ +#' @include geom-tile.R +NULL + #' Heatmap of 2d bin counts #' #' Divides the plane into rectangles, counts the number of cases in @@ -26,27 +29,7 @@ #' #' # 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 = GeomTile, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} +geom_bin_2d <- boilerplate(GeomTile, stat = "bin2d") #' @export #' @rdname geom_bin_2d diff --git a/R/geom-col.R b/R/geom-col.R index 77c756f573..f779fb6e3a 100644 --- a/R/geom-col.R +++ b/R/geom-col.R @@ -1,28 +1,6 @@ #' @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, - ... - ) - ) -} +geom_col <- boilerplate(GeomBar, position = "stack", just = 0.5) #' @rdname ggplot2-ggproto #' @format NULL diff --git a/R/geom-contour.R b/R/geom-contour.R index a73bc3a135..7bd4c17e39 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 @@ -56,87 +79,15 @@ #' 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 <- boilerplate( + GeomContour, stat = "contour", + bins = NULL, binwidth = NULL, breaks = NULL, + lineend = "butt", linejoin = "round", linemitre = 10 +) #' @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 <- boilerplate( + GeomContourFilled, stat = "contour_filled", + 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..a3c6de4cc2 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 <- boilerplate(GeomPoint, stat = "sum") diff --git a/R/geom-crossbar.R b/R/geom-crossbar.R index 1f7c66f832..2946f703c5 100644 --- a/R/geom-crossbar.R +++ b/R/geom-crossbar.R @@ -1,30 +1,3 @@ -#' @export -#' @rdname geom_linerange -geom_crossbar <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - ..., - fatten = 2.5, - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomCrossbar, - 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 @@ -117,3 +90,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, rename_size = TRUE ) + +#' @export +#' @rdname geom_linerange +geom_crossbar <- boilerplate(GeomCrossbar, fatten = 2.5, orientation = NA) diff --git a/R/geom-curve.R b/R/geom-curve.R index e1c38d1cd4..dd95a1deab 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,51 @@ 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 <- boilerplate( + GeomCurve, + curvature = 0.5, angle = 90, ncp = 5, + arrow = NULL, arrow.fill = NULL, + lineend = "butt" ) diff --git a/R/geom-density.R b/R/geom-density.R index a4a7754f2e..e94c5157ce 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 @@ -86,14 +99,4 @@ geom_density <- function(mapping = NULL, data = NULL, ) } -#' @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 - ) -) + diff --git a/R/geom-errorbar.R b/R/geom-errorbar.R index 3e40b20318..05deae5886 100644 --- a/R/geom-errorbar.R +++ b/R/geom-errorbar.R @@ -1,28 +1,3 @@ -#' @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, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -80,3 +55,7 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, rename_size = TRUE ) + +#' @export +#' @rdname geom_linerange +geom_errorbar <- boilerplate(GeomErrorbar, orientation = NA) diff --git a/R/geom-errorbarh.R b/R/geom-errorbarh.R index c38b9b7cd6..013bcf0b19 100644 --- a/R/geom-errorbarh.R +++ b/R/geom-errorbarh.R @@ -1,51 +1,3 @@ -#' Horizontal error bars -#' -#' A rotated version of [geom_errorbar()]. -#' -#' @eval rd_aesthetics("geom", "errorbarh") -#' @inheritParams layer -#' @inheritParams geom_point -#' @export -#' @examples -#' df <- data.frame( -#' trt = factor(c(1, 1, 2, 2)), -#' resp = c(1, 5, 3, 4), -#' group = factor(c(1, 2, 1, 2)), -#' se = c(0.1, 0.3, 0.3, 0.2) -#' ) -#' -#' # Define the top and bottom of the errorbars -#' -#' p <- ggplot(df, aes(resp, trt, colour = group)) -#' p + -#' geom_point() + -#' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se)) -#' -#' p + -#' geom_point() + -#' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2)) -geom_errorbarh <- 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 = GeomErrorbarh, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm, - ... - ) - ) -} - - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -89,3 +41,31 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, rename_size = TRUE ) + +#' Horizontal error bars +#' +#' A rotated version of [geom_errorbar()]. +#' +#' @eval rd_aesthetics("geom", "errorbarh") +#' @inheritParams layer +#' @inheritParams geom_point +#' @export +#' @examples +#' df <- data.frame( +#' trt = factor(c(1, 1, 2, 2)), +#' resp = c(1, 5, 3, 4), +#' group = factor(c(1, 2, 1, 2)), +#' se = c(0.1, 0.3, 0.3, 0.2) +#' ) +#' +#' # Define the top and bottom of the errorbars +#' +#' p <- ggplot(df, aes(resp, trt, colour = group)) +#' p + +#' geom_point() + +#' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se)) +#' +#' p + +#' geom_point() + +#' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2)) +geom_errorbarh <- boilerplate(GeomErrorbarh) diff --git a/R/geom-hex.R b/R/geom-hex.R index 152227a40b..96d5433561 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,36 @@ 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 +#' @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 <- boilerplate(GeomHex, stat = 'binhex') diff --git a/R/geom-histogram.R b/R/geom-histogram.R index dafc181f15..8fcd572548 100644 --- a/R/geom-histogram.R +++ b/R/geom-histogram.R @@ -115,31 +115,7 @@ #' 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 <- boilerplate( + GeomBar, stat = "bin", position = "stack", + binwidth = NULL, bins = NULL, orientation = NA +) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index 83360800e2..de61ac2456 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`, @@ -63,68 +107,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 <- boilerplate(GeomLinerange, orientation = NA) diff --git a/R/geom-path.R b/R/geom-path.R index 72c4f7154e..d012283419 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,138 @@ 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 <- boilerplate( + GeomPath, + lineend = "butt", linejoin = "round", linemitre = 10, + arrow = NULL, arrow.fill = NULL +) + +#' @export +#' @rdname geom_path +geom_line <- boilerplate(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 <- boilerplate(GeomStep, direction = "hv", 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 3efa394c31..d63bd0fede 100644 --- a/R/geom-point.R +++ b/R/geom-point.R @@ -1,3 +1,39 @@ +#' @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) { + if (is.character(data$shape)) { + 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 @@ -106,62 +142,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) { - if (is.character(data$shape)) { - 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 <- boilerplate(GeomPoint) #' Translating shape strings #' diff --git a/R/geom-pointrange.R b/R/geom-pointrange.R index d0e5194311..4c709be77c 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 = 4, - 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 @@ -71,3 +44,7 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, ) } ) + +#' @export +#' @rdname geom_linerange +geom_pointrange <- boilerplate(GeomPointrange, fatten = 4, orientation = NA) diff --git a/R/geom-polygon.R b/R/geom-polygon.R index a271ef5011..b9c6836cb0 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 boilerplates.R +NULL #' @rdname ggplot2-ggproto #' @format NULL @@ -194,6 +93,88 @@ 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 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 <- boilerplate(GeomPolygon, rule = "evenodd") + # 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..9a3a64fa20 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,7 @@ #' #' # 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 <- boilerplate( + GeomQuantile, stat = "quantile", + lineend = "butt", linejoin = "round", linemitre = 10 ) diff --git a/R/geom-rect.R b/R/geom-rect.R index 8473474525..60f23a584c 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 <- boilerplate(GeomRect, linejoin = "mitre") + 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-rug.R b/R/geom-rug.R index d675474f43..f157922b40 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(1, 1, 1, 1, "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,62 @@ 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. +#' @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(1, 1, 1, 1, "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 <- boilerplate( + GeomRug, + outside = FALSE, sides = "bl", length = unit(0.03, "npc") +) diff --git a/R/geom-segment.R b/R/geom-segment.R index 00d9eff87a..8884c68a39 100644 --- a/R/geom-segment.R +++ b/R/geom-segment.R @@ -1,3 +1,63 @@ +#' @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 <- check_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 +128,8 @@ #' #' 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 <- check_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 <- boilerplate( + GeomSegment, + arrow = NULL, arrow.fill = NULL, + lineend = "butt", linejoin = "round" ) 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..6ed4e89880 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 <- boilerplate(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 e7bb6bc9e3..6e37908f4e 100644 --- a/R/geom-tile.R +++ b/R/geom-tile.R @@ -1,3 +1,42 @@ +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +#' @include geom-rect.R +GeomTile <- ggproto("GeomTile", GeomRect, + extra_params = c("na.rm"), + + setup_data = function(data, params) { + + data$width <- data$width %||% params$width %||% + stats::ave(data$x, data$PANEL, FUN = function(x) resolution(x, FALSE, TRUE)) + data$height <- data$height %||% params$height %||% + stats::ave(data$y, data$PANEL, FUN = function(y) resolution(y, FALSE, 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 = NA, height = NA + ), + + 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,64 +117,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(data, params) { - - data$width <- data$width %||% params$width %||% - stats::ave(data$x, data$PANEL, FUN = function(x) resolution(x, FALSE, TRUE)) - data$height <- data$height %||% params$height %||% - stats::ave(data$y, data$PANEL, FUN = function(y) resolution(y, FALSE, 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 = NA, height = NA - ), - - 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 <- boilerplate(GeomTile, linejoin = "mitre") diff --git a/R/geom-violin.R b/R/geom-violin.R index 9976e5b8a4..915e927727 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -1,124 +1,3 @@ -#' Violin plot -#' -#' A violin plot is a compact display of a continuous distribution. It is a -#' blend of [geom_boxplot()] and [geom_density()]: a -#' violin plot is a mirrored density plot displayed in the same way as a -#' boxplot. -#' -#' @eval rd_orientation() -#' -#' @eval rd_aesthetics("geom", "violin") -#' @inheritParams layer -#' @inheritParams geom_bar -#' @param draw_quantiles If `not(NULL)` (default), draw horizontal lines -#' at the given quantiles of the density estimate. -#' @param trim If `TRUE` (default), trim the tails of the violins -#' to the range of the data. If `FALSE`, don't trim the tails. -#' @param geom,stat Use to override the default connection between -#' `geom_violin()` and `stat_ydensity()`. For more information about -#' overriding these connections, see how the [stat][layer_stats] and -#' [geom][layer_geoms] arguments work. -#' @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. -#' @export -#' @references Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box -#' Plot-Density Trace Synergism. The American Statistician 52, 181-184. -#' @examples -#' p <- ggplot(mtcars, aes(factor(cyl), mpg)) -#' p + geom_violin() -#' -#' # Orientation follows the discrete axis -#' ggplot(mtcars, aes(mpg, factor(cyl))) + -#' geom_violin() -#' -#' \donttest{ -#' p + geom_violin() + geom_jitter(height = 0, width = 0.1) -#' -#' # Scale maximum width proportional to sample size: -#' p + geom_violin(scale = "count") -#' -#' # Scale maximum width to 1 for all violins: -#' p + geom_violin(scale = "width") -#' -#' # Default is to trim violins to the range of the data. To disable: -#' p + geom_violin(trim = FALSE) -#' -#' # Use a smaller bandwidth for closer density fit (default is 1). -#' p + geom_violin(adjust = .5) -#' -#' # Add aesthetic mappings -#' # Note that violins are automatically dodged when any aesthetic is -#' # a factor -#' p + geom_violin(aes(fill = cyl)) -#' p + geom_violin(aes(fill = factor(cyl))) -#' p + geom_violin(aes(fill = factor(vs))) -#' p + geom_violin(aes(fill = factor(am))) -#' -#' # Set aesthetics to fixed value -#' p + geom_violin(fill = "grey80", colour = "#3366FF") -#' -#' # Show quartiles -#' p + geom_violin(draw_quantiles = c(0.25, 0.5, 0.75)) -#' -#' # Scales vs. coordinate transforms ------- -#' if (require("ggplot2movies")) { -#' # Scale transformations occur before the density statistics are computed. -#' # Coordinate transformations occur afterwards. Observe the effect on the -#' # number of outliers. -#' m <- ggplot(movies, aes(y = votes, x = rating, group = cut_width(rating, 0.5))) -#' m + geom_violin() -#' m + -#' geom_violin() + -#' scale_y_log10() -#' m + -#' geom_violin() + -#' coord_trans(y = "log10") -#' m + -#' geom_violin() + -#' scale_y_log10() + coord_trans(y = "log10") -#' -#' # Violin plots with continuous x: -#' # Use the group aesthetic to group observations in violins -#' ggplot(movies, aes(year, budget)) + -#' geom_violin() -#' ggplot(movies, aes(year, budget)) + -#' geom_violin(aes(group = cut_width(year, 10)), scale = "width") -#' } -#' } -geom_violin <- function(mapping = NULL, data = NULL, - stat = "ydensity", position = "dodge", - ..., - draw_quantiles = NULL, - trim = TRUE, - bounds = c(-Inf, Inf), - scale = "area", - na.rm = FALSE, - orientation = NA, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = stat, - geom = GeomViolin, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - trim = trim, - scale = scale, - draw_quantiles = draw_quantiles, - na.rm = na.rm, - orientation = orientation, - bounds = bounds, - ... - ) - ) -} - #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -211,6 +90,101 @@ GeomViolin <- ggproto("GeomViolin", Geom, rename_size = TRUE ) +#' Violin plot +#' +#' A violin plot is a compact display of a continuous distribution. It is a +#' blend of [geom_boxplot()] and [geom_density()]: a +#' violin plot is a mirrored density plot displayed in the same way as a +#' boxplot. +#' +#' @eval rd_orientation() +#' +#' @eval rd_aesthetics("geom", "violin") +#' @inheritParams layer +#' @inheritParams geom_bar +#' @param draw_quantiles If `not(NULL)` (default), draw horizontal lines +#' at the given quantiles of the density estimate. +#' @param trim If `TRUE` (default), trim the tails of the violins +#' to the range of the data. If `FALSE`, don't trim the tails. +#' @param geom,stat Use to override the default connection between +#' `geom_violin()` and `stat_ydensity()`. For more information about +#' overriding these connections, see how the [stat][layer_stats] and +#' [geom][layer_geoms] arguments work. +#' @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. +#' @export +#' @references Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box +#' Plot-Density Trace Synergism. The American Statistician 52, 181-184. +#' @examples +#' p <- ggplot(mtcars, aes(factor(cyl), mpg)) +#' p + geom_violin() +#' +#' # Orientation follows the discrete axis +#' ggplot(mtcars, aes(mpg, factor(cyl))) + +#' geom_violin() +#' +#' \donttest{ +#' p + geom_violin() + geom_jitter(height = 0, width = 0.1) +#' +#' # Scale maximum width proportional to sample size: +#' p + geom_violin(scale = "count") +#' +#' # Scale maximum width to 1 for all violins: +#' p + geom_violin(scale = "width") +#' +#' # Default is to trim violins to the range of the data. To disable: +#' p + geom_violin(trim = FALSE) +#' +#' # Use a smaller bandwidth for closer density fit (default is 1). +#' p + geom_violin(adjust = .5) +#' +#' # Add aesthetic mappings +#' # Note that violins are automatically dodged when any aesthetic is +#' # a factor +#' p + geom_violin(aes(fill = cyl)) +#' p + geom_violin(aes(fill = factor(cyl))) +#' p + geom_violin(aes(fill = factor(vs))) +#' p + geom_violin(aes(fill = factor(am))) +#' +#' # Set aesthetics to fixed value +#' p + geom_violin(fill = "grey80", colour = "#3366FF") +#' +#' # Show quartiles +#' p + geom_violin(draw_quantiles = c(0.25, 0.5, 0.75)) +#' +#' # Scales vs. coordinate transforms ------- +#' if (require("ggplot2movies")) { +#' # Scale transformations occur before the density statistics are computed. +#' # Coordinate transformations occur afterwards. Observe the effect on the +#' # number of outliers. +#' m <- ggplot(movies, aes(y = votes, x = rating, group = cut_width(rating, 0.5))) +#' m + geom_violin() +#' m + +#' geom_violin() + +#' scale_y_log10() +#' m + +#' geom_violin() + +#' coord_trans(y = "log10") +#' m + +#' geom_violin() + +#' scale_y_log10() + coord_trans(y = "log10") +#' +#' # Violin plots with continuous x: +#' # Use the group aesthetic to group observations in violins +#' ggplot(movies, aes(year, budget)) + +#' geom_violin() +#' ggplot(movies, aes(year, budget)) + +#' geom_violin(aes(group = cut_width(year, 10)), scale = "width") +#' } +#' } +geom_violin <- boilerplate( + GeomViolin, stat = "ydensity", position = "dodge", + draw_quantiles = NULL, trim = TRUE, bounds = c(-Inf, Inf), scale = "area" +) + # Returns a data.frame with info needed to draw quantile segments. create_quantile_segment_frame <- function(data, draw_quantiles) { dens <- cumsum(data$density) / sum(data$density) diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index 6c8c67cc19..ab29957798 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -13,8 +13,8 @@ geom_bar( position = "stack", ..., just = 0.5, - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -22,6 +22,7 @@ geom_bar( geom_col( mapping = NULL, data = NULL, + stat = "identity", position = "stack", ..., just = 0.5, @@ -110,14 +111,14 @@ 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{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{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/geom_histogram.Rd b/man/geom_histogram.Rd index 1f290dbcdc..eda1362109 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -26,8 +26,8 @@ geom_histogram( ..., binwidth = NULL, bins = NULL, - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 87bc5c8e75..4d8b09866f 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -15,8 +15,8 @@ geom_crossbar( position = "identity", ..., fatten = 2.5, - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -27,8 +27,8 @@ geom_errorbar( stat = "identity", position = "identity", ..., - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -39,8 +39,8 @@ geom_linerange( stat = "identity", position = "identity", ..., - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -52,8 +52,8 @@ geom_pointrange( position = "identity", ..., fatten = 4, - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE ) @@ -137,14 +137,14 @@ lists which parameters it can accept. middle bar in \code{geom_crossbar()} and the middle point in \code{geom_pointrange()}.} -\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{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/geom_path.Rd b/man/geom_path.Rd index 88913a5a7b..527a6ecd68 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -27,11 +27,11 @@ geom_line( data = NULL, stat = "identity", position = "identity", - na.rm = FALSE, + ..., orientation = NA, + na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, - ... + inherit.aes = TRUE ) geom_step( @@ -39,12 +39,12 @@ geom_step( data = NULL, stat = "identity", position = "identity", + ..., direction = "hv", - na.rm = FALSE, orientation = NA, + na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, - ... + inherit.aes = TRUE ) } \arguments{ diff --git a/man/geom_polygon.Rd b/man/geom_polygon.Rd index 241490284a..deb1289d07 100644 --- a/man/geom_polygon.Rd +++ b/man/geom_polygon.Rd @@ -9,8 +9,8 @@ geom_polygon( data = NULL, stat = "identity", position = "identity", - rule = "evenodd", ..., + rule = "evenodd", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -63,11 +63,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 +91,11 @@ 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{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} @@ -197,7 +197,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_rug.Rd b/man/geom_rug.Rd index 1cc10e785a..94b6ee3032 100644 --- a/man/geom_rug.Rd +++ b/man/geom_rug.Rd @@ -177,5 +177,4 @@ p + p + geom_rug(length = unit(0.05, "npc")) + scale_y_continuous(expand = c(0.1, 0.1)) - } diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 974d1c5bdc..97290c0cda 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -16,7 +16,6 @@ geom_violin( bounds = c(-Inf, Inf), scale = "area", na.rm = FALSE, - orientation = NA, show.legend = NA, inherit.aes = TRUE ) @@ -121,11 +120,6 @@ observations. If "width", all violins have the same maximum width.} \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. @@ -159,6 +153,11 @@ 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{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{ 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 c3384f1e45..46c62bbb2d 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -5,28 +5,27 @@ % R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, R/coord-map.R, % R/coord-polar.R, R/coord-quickmap.R, R/coord-radial.R, R/coord-transform.R, % 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-blank.R, +% R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, R/geom-tile.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-errorbarh.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-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-errorbarh.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-tile.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, R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R, -% R/guide-colorsteps.R, R/guide-custom.R, R/guide-none.R, R/guide-old.R, -% R/layout.R, R/position-.R, R/position-dodge.R, R/position-dodge2.R, -% R/position-identity.R, R/position-jitter.R, R/position-jitterdodge.R, -% R/position-nudge.R, R/position-stack.R, R/scale-.R, R/scale-binned.R, -% R/scale-continuous.R, R/scale-date.R, R/scale-discrete-.R, -% R/scale-identity.R, R/stat-align.R, R/stat-bin.R, R/stat-bin2d.R, -% R/stat-bindot.R, R/stat-binhex.R, R/stat-boxplot.R, R/stat-contour.R, -% R/stat-count.R, R/stat-density-2d.R, R/stat-density.R, R/stat-ecdf.R, -% R/stat-ellipse.R, R/stat-function.R, R/stat-identity.R, R/stat-qq-line.R, -% R/stat-qq.R, R/stat-quantilemethods.R, R/stat-smooth.R, R/stat-sum.R, -% R/stat-summary-2d.R, R/stat-summary-bin.R, R/stat-summary-hex.R, -% R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.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, +% R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R, R/guide-colorsteps.R, +% R/guide-custom.R, R/guide-none.R, R/guide-old.R, R/layout.R, R/position-.R, +% R/position-dodge.R, R/position-dodge2.R, R/position-identity.R, +% R/position-jitter.R, R/position-jitterdodge.R, R/position-nudge.R, +% R/position-stack.R, R/scale-.R, R/scale-binned.R, R/scale-continuous.R, +% R/scale-date.R, R/scale-discrete-.R, R/scale-identity.R, R/stat-align.R, +% R/stat-bin.R, R/stat-bin2d.R, R/stat-bindot.R, R/stat-binhex.R, +% R/stat-boxplot.R, R/stat-contour.R, R/stat-count.R, R/stat-density-2d.R, +% R/stat-density.R, R/stat-ecdf.R, R/stat-ellipse.R, R/stat-function.R, +% R/stat-identity.R, R/stat-qq-line.R, R/stat-qq.R, R/stat-quantilemethods.R, +% R/stat-smooth.R, R/stat-sum.R, R/stat-summary-2d.R, R/stat-summary-bin.R, +% R/stat-summary-hex.R, R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.R \docType{data} \name{ggplot2-ggproto} \alias{ggplot2-ggproto} @@ -56,6 +55,7 @@ \alias{GeomAbline} \alias{GeomRect} \alias{GeomBar} +\alias{GeomTile} \alias{GeomBlank} \alias{GeomBoxplot} \alias{GeomCol} @@ -64,6 +64,7 @@ \alias{GeomStep} \alias{GeomContour} \alias{GeomContourFilled} +\alias{GeomPoint} \alias{GeomCrossbar} \alias{GeomSegment} \alias{GeomCurve} @@ -80,14 +81,12 @@ \alias{GeomHline} \alias{GeomLabel} \alias{GeomLinerange} -\alias{GeomPoint} \alias{GeomPointrange} \alias{GeomQuantile} \alias{GeomRug} \alias{GeomSmooth} \alias{GeomSpoke} \alias{GeomText} -\alias{GeomTile} \alias{GeomViolin} \alias{GeomVline} \alias{Guide} diff --git a/man/is_tests.Rd b/man/is_tests.Rd index 62ded3db09..3274dc5b06 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.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.element(x) is.guide(x) -is.layer(x) - is.guides(x) is.margin(x) From 3eee99f11e8101b5b71d53e00255b314c373648d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 17 Oct 2024 11:33:05 +0200 Subject: [PATCH 03/12] write out all non-standard arguments --- R/geom-bar.R | 5 ++++- R/geom-bin2d.R | 7 ++++++- R/geom-col.R | 5 ++++- R/geom-contour.R | 11 +++++++++-- R/geom-crossbar.R | 6 +++++- R/geom-errorbar.R | 5 ++++- R/geom-errorbarh.R | 3 ++- R/geom-hex.R | 8 +++++++- R/geom-histogram.R | 3 ++- R/geom-linerange.R | 4 +++- R/geom-path.R | 14 ++++++++++++-- R/geom-pointrange.R | 2 +- R/geom-polygon.R | 8 +++++++- R/geom-quantile.R | 3 ++- R/geom-rect.R | 2 +- R/geom-rug.R | 3 ++- R/geom-spoke.R | 6 +++++- R/geom-tile.R | 2 +- man/borders.Rd | 3 +++ man/geom_bar.Rd | 8 ++++++++ man/geom_bin_2d.Rd | 6 ++++++ man/geom_contour.Rd | 16 ++++++++++++++++ man/geom_errorbarh.Rd | 3 +++ man/geom_hex.Rd | 9 +++++++++ man/geom_histogram.Rd | 6 ++++++ man/geom_linerange.Rd | 13 +++++++++++++ man/geom_path.Rd | 10 ++++++++++ man/geom_polygon.Rd | 9 +++++++++ man/geom_quantile.Rd | 7 +++++++ man/geom_rug.Rd | 3 +++ man/geom_spoke.Rd | 13 +++++++++++++ man/geom_tile.Rd | 4 ++++ 32 files changed, 187 insertions(+), 20 deletions(-) diff --git a/R/geom-bar.R b/R/geom-bar.R index 3027d02f53..97fb689ced 100644 --- a/R/geom-bar.R +++ b/R/geom-bar.R @@ -90,6 +90,8 @@ GeomBar <- ggproto("GeomBar", GeomRect, #' @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) @@ -136,5 +138,6 @@ GeomBar <- ggproto("GeomBar", GeomRect, #' ggplot(df, aes(x, y)) + geom_col(just = 1) geom_bar <- boilerplate( GeomBar, stat = "count", position = "stack", - just = 0.5, orientation = NA + just = 0.5, orientation = NA, + lineend = "butt", linejoin = "mitre" ) diff --git a/R/geom-bin2d.R b/R/geom-bin2d.R index 1534b9a7ae..4e401655f6 100644 --- a/R/geom-bin2d.R +++ b/R/geom-bin2d.R @@ -17,6 +17,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,7 +31,10 @@ NULL #' #' # Or by specifying the width of the bins #' d + geom_bin_2d(binwidth = c(0.1, 0.1)) -geom_bin_2d <- boilerplate(GeomTile, stat = "bin2d") +geom_bin_2d <- boilerplate( + GeomTile, stat = "bin2d", + lineend = "butt", linejoin = "mitre" +) #' @export #' @rdname geom_bin_2d diff --git a/R/geom-col.R b/R/geom-col.R index f779fb6e3a..3ce9ad55fd 100644 --- a/R/geom-col.R +++ b/R/geom-col.R @@ -1,6 +1,9 @@ #' @export #' @rdname geom_bar -geom_col <- boilerplate(GeomBar, position = "stack", just = 0.5) +geom_col <- boilerplate( + GeomBar, position = "stack", + just = 0.5, lineend = "butt", linejoin = "mitre" +) #' @rdname ggplot2-ggproto #' @format NULL diff --git a/R/geom-contour.R b/R/geom-contour.R index 7bd4c17e39..51f9316d13 100644 --- a/R/geom-contour.R +++ b/R/geom-contour.R @@ -49,6 +49,10 @@ GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon) #' #' 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 @@ -82,12 +86,15 @@ GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon) geom_contour <- boilerplate( GeomContour, stat = "contour", bins = NULL, binwidth = NULL, breaks = NULL, - lineend = "butt", linejoin = "round", linemitre = 10 + lineend = "butt", linejoin = "round", linemitre = 10, + arrow = NULL, arrow.fill = NULL ) #' @rdname geom_contour #' @export geom_contour_filled <- boilerplate( GeomContourFilled, stat = "contour_filled", - bins = NULL, binwidth = NULL, breaks = NULL + bins = NULL, binwidth = NULL, breaks = NULL, + rule = "evenodd", + lineend = "butt", linejoin = "round", linemitre = 10 ) diff --git a/R/geom-crossbar.R b/R/geom-crossbar.R index 2946f703c5..bd32f7b9c6 100644 --- a/R/geom-crossbar.R +++ b/R/geom-crossbar.R @@ -93,4 +93,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, #' @export #' @rdname geom_linerange -geom_crossbar <- boilerplate(GeomCrossbar, fatten = 2.5, orientation = NA) +geom_crossbar <- boilerplate( + GeomCrossbar, + fatten = 2.5, orientation = NA, width = NULL, + lineend = "butt", linejoin = "mitre" +) diff --git a/R/geom-errorbar.R b/R/geom-errorbar.R index 05deae5886..1d57ac5c83 100644 --- a/R/geom-errorbar.R +++ b/R/geom-errorbar.R @@ -58,4 +58,7 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, #' @export #' @rdname geom_linerange -geom_errorbar <- boilerplate(GeomErrorbar, orientation = NA) +geom_errorbar <- boilerplate( + GeomErrorbar, + orientation = NA, lineend = "butt" +) diff --git a/R/geom-errorbarh.R b/R/geom-errorbarh.R index 013bcf0b19..9695ce1428 100644 --- a/R/geom-errorbarh.R +++ b/R/geom-errorbarh.R @@ -49,6 +49,7 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, #' @eval rd_aesthetics("geom", "errorbarh") #' @inheritParams layer #' @inheritParams geom_point +#' @param lineend Line end style (round, butt, square). #' @export #' @examples #' df <- data.frame( @@ -68,4 +69,4 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, #' p + #' geom_point() + #' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2)) -geom_errorbarh <- boilerplate(GeomErrorbarh) +geom_errorbarh <- boilerplate(GeomErrorbarh, lineend = "butt") diff --git a/R/geom-hex.R b/R/geom-hex.R index 96d5433561..f0ccd557f0 100644 --- a/R/geom-hex.R +++ b/R/geom-hex.R @@ -82,6 +82,9 @@ GeomHex <- ggproto("GeomHex", Geom, #' @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)) @@ -97,4 +100,7 @@ GeomHex <- ggproto("GeomHex", Geom, #' d + geom_hex(binwidth = c(1, 1000)) #' d + geom_hex(binwidth = c(.1, 500)) #' } -geom_hex <- boilerplate(GeomHex, stat = 'binhex') +geom_hex <- boilerplate( + GeomHex, stat = 'binhex', + lineend = "butt", linejoin = "mitre", linemitre = 10 +) diff --git a/R/geom-histogram.R b/R/geom-histogram.R index 8fcd572548..07ec01de2d 100644 --- a/R/geom-histogram.R +++ b/R/geom-histogram.R @@ -117,5 +117,6 @@ #' geom_histogram(binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3))) geom_histogram <- boilerplate( GeomBar, stat = "bin", position = "stack", - binwidth = NULL, bins = NULL, orientation = NA + binwidth = NULL, bins = NULL, orientation = NA, + lineend = "butt", linejoin = "mitre" ) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index de61ac2456..c404db4121 100644 --- a/R/geom-linerange.R +++ b/R/geom-linerange.R @@ -60,6 +60,8 @@ GeomLinerange <- ggproto( #' @export #' @inheritParams layer #' @inheritParams geom_bar +#' @param width Bar width. By default, set to 90% of the [`resolution()`] of +#' the data. #' @examples #' # Create a simple example dataset #' df <- data.frame( @@ -107,4 +109,4 @@ GeomLinerange <- ggproto( #' aes(ymin = lower, ymax = upper), #' position = position_dodge2(width = 0.5, padding = 0.5) #' ) -geom_linerange <- boilerplate(GeomLinerange, orientation = NA) +geom_linerange <- boilerplate(GeomLinerange, orientation = NA, lineend = "butt") diff --git a/R/geom-path.R b/R/geom-path.R index d012283419..6bcde42109 100644 --- a/R/geom-path.R +++ b/R/geom-path.R @@ -274,14 +274,24 @@ geom_path <- boilerplate( #' @export #' @rdname geom_path -geom_line <- boilerplate(GeomLine, orientation = NA) +geom_line <- boilerplate( + GeomLine, + orientation = NA, + arrow = NULL, arrow.fill = NULL, + lineend = "butt", linejoin = "round", linemitre = 10 +) #' @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 <- boilerplate(GeomStep, direction = "hv", orientation = NA) +geom_step <- boilerplate( + GeomStep, + direction = "hv", orientation = NA, + arrow = NULL, arrow.fill = NULL, + lineend = "butt", linejoin = "round", linemitre = 10 +) # Trim false values from left and right: keep all values from # first TRUE to last TRUE diff --git a/R/geom-pointrange.R b/R/geom-pointrange.R index 4c709be77c..84d557e430 100644 --- a/R/geom-pointrange.R +++ b/R/geom-pointrange.R @@ -47,4 +47,4 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, #' @export #' @rdname geom_linerange -geom_pointrange <- boilerplate(GeomPointrange, fatten = 4, orientation = NA) +geom_pointrange <- boilerplate(GeomPointrange, fatten = 4, orientation = NA, lineend = "butt") diff --git a/R/geom-polygon.R b/R/geom-polygon.R index b9c6836cb0..344db19fba 100644 --- a/R/geom-polygon.R +++ b/R/geom-polygon.R @@ -110,6 +110,9 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, #' @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 @@ -173,7 +176,10 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, #' geom_polygon(aes(fill = value, group = id, subgroup = subid)) #' p #' } -geom_polygon <- boilerplate(GeomPolygon, rule = "evenodd") +geom_polygon <- boilerplate( + GeomPolygon, rule = "evenodd", + lineend = "butt", linejoin = "round", linemitre = 10 +) # Assigning pathGrob in .onLoad ensures that packages that subclass GeomPolygon # do not install with error `possible error in 'pathGrob(munched$x, munched$y, ': diff --git a/R/geom-quantile.R b/R/geom-quantile.R index 9a3a64fa20..975181174f 100644 --- a/R/geom-quantile.R +++ b/R/geom-quantile.R @@ -46,5 +46,6 @@ GeomQuantile <- ggproto( #' m + geom_quantile(colour = "red", linewidth = 2, alpha = 0.5) geom_quantile <- boilerplate( GeomQuantile, stat = "quantile", - lineend = "butt", linejoin = "round", linemitre = 10 + lineend = "butt", linejoin = "round", linemitre = 10, + arrow = NULL, arrow.fill = NULL ) diff --git a/R/geom-rect.R b/R/geom-rect.R index 60f23a584c..4eba984433 100644 --- a/R/geom-rect.R +++ b/R/geom-rect.R @@ -86,7 +86,7 @@ GeomRect <- ggproto("GeomRect", Geom, #' @export #' @rdname geom_tile -geom_rect <- boilerplate(GeomRect, linejoin = "mitre") +geom_rect <- boilerplate(GeomRect, linejoin = "mitre", lineend = "butt") resolve_rect <- function(min = NULL, max = NULL, center = NULL, length = NULL, fun, type) { diff --git a/R/geom-rug.R b/R/geom-rug.R index f157922b40..4ec9645c82 100644 --- a/R/geom-rug.R +++ b/R/geom-rug.R @@ -145,6 +145,7 @@ GeomRug <- ggproto("GeomRug", Geom, #' 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)) + @@ -182,5 +183,5 @@ GeomRug <- ggproto("GeomRug", Geom, #' scale_y_continuous(expand = c(0.1, 0.1)) geom_rug <- boilerplate( GeomRug, - outside = FALSE, sides = "bl", length = unit(0.03, "npc") + outside = FALSE, sides = "bl", length = unit(0.03, "npc"), lineend = "butt" ) diff --git a/R/geom-spoke.R b/R/geom-spoke.R index 6ed4e89880..f20aebf66e 100644 --- a/R/geom-spoke.R +++ b/R/geom-spoke.R @@ -40,7 +40,11 @@ GeomSpoke <- ggproto( #' ggplot(df, aes(x, y)) + #' geom_point() + #' geom_spoke(aes(angle = angle, radius = speed)) -geom_spoke <- boilerplate(GeomSpoke) +geom_spoke <- boilerplate( + GeomSpoke, + lineend = "butt", linejoin = "round", + arrow = NULL, arrow.fill = NULL +) #' @export #' @rdname geom_spoke diff --git a/R/geom-tile.R b/R/geom-tile.R index 6e37908f4e..b68637d396 100644 --- a/R/geom-tile.R +++ b/R/geom-tile.R @@ -117,4 +117,4 @@ GeomTile <- ggproto("GeomTile", GeomRect, #' position = "identity" #' ) #' } -geom_tile <- boilerplate(GeomTile, linejoin = "mitre") +geom_tile <- boilerplate(GeomTile, lineend = "butt", linejoin = "mitre") 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 ab29957798..a136df19cf 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -14,6 +14,8 @@ geom_bar( ..., just = 0.5, orientation = NA, + lineend = "butt", + linejoin = "mitre", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -26,6 +28,8 @@ geom_col( position = "stack", ..., just = 0.5, + lineend = "butt", + linejoin = "mitre", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -116,6 +120,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{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_bin_2d.Rd b/man/geom_bin_2d.Rd index fa3b32b4ce..121cf0765c 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 @@ -94,6 +96,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.} diff --git a/man/geom_contour.Rd b/man/geom_contour.Rd index c42aec41c9..1758dfe88e 100644 --- a/man/geom_contour.Rd +++ b/man/geom_contour.Rd @@ -19,6 +19,8 @@ geom_contour( lineend = "butt", linejoin = "round", linemitre = 10, + arrow = NULL, + arrow.fill = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -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 @@ -162,6 +168,11 @@ ten with \code{\link[=pretty]{pretty()}} breaks.} \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.} @@ -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_errorbarh.Rd b/man/geom_errorbarh.Rd index 4e6fb3aae9..810a18042d 100644 --- a/man/geom_errorbarh.Rd +++ b/man/geom_errorbarh.Rd @@ -10,6 +10,7 @@ geom_errorbarh( stat = "identity", position = "identity", ..., + lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -90,6 +91,8 @@ 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{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 553787761b..0079b1e89c 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 @@ -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.} diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index eda1362109..fbf7b29184 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -27,6 +27,8 @@ geom_histogram( binwidth = NULL, bins = NULL, orientation = NA, + lineend = "butt", + linejoin = "mitre", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -148,6 +150,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 diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 4d8b09866f..471caba518 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -16,6 +16,9 @@ geom_crossbar( ..., fatten = 2.5, orientation = NA, + width = NULL, + lineend = "butt", + linejoin = "mitre", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -28,6 +31,7 @@ geom_errorbar( position = "identity", ..., orientation = NA, + lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -40,6 +44,7 @@ geom_linerange( position = "identity", ..., orientation = NA, + lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -53,6 +58,7 @@ geom_pointrange( ..., fatten = 4, orientation = NA, + lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -142,6 +148,13 @@ 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{width}{Bar width. By default, set to 90\% of the \code{\link[=resolution]{resolution()}} of +the data.} + +\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_path.Rd b/man/geom_path.Rd index 527a6ecd68..a5416ac27c 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -29,6 +29,11 @@ geom_line( position = "identity", ..., orientation = NA, + arrow = NULL, + arrow.fill = NULL, + lineend = "butt", + linejoin = "round", + linemitre = 10, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -42,6 +47,11 @@ geom_step( ..., direction = "hv", orientation = NA, + arrow = NULL, + arrow.fill = NULL, + lineend = "butt", + linejoin = "round", + linemitre = 10, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE diff --git a/man/geom_polygon.Rd b/man/geom_polygon.Rd index deb1289d07..e1f40f6c1a 100644 --- a/man/geom_polygon.Rd +++ b/man/geom_polygon.Rd @@ -11,6 +11,9 @@ geom_polygon( position = "identity", ..., rule = "evenodd", + lineend = "butt", + linejoin = "round", + linemitre = 10, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -96,6 +99,12 @@ 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.} diff --git a/man/geom_quantile.Rd b/man/geom_quantile.Rd index 568c33e970..8a80b86db9 100644 --- a/man/geom_quantile.Rd +++ b/man/geom_quantile.Rd @@ -14,6 +14,8 @@ geom_quantile( lineend = "butt", linejoin = "round", linemitre = 10, + arrow = NULL, + arrow.fill = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -102,6 +104,11 @@ lists which parameters it can accept. \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_rug.Rd b/man/geom_rug.Rd index 94b6ee3032..4f9a4f9250 100644 --- a/man/geom_rug.Rd +++ b/man/geom_rug.Rd @@ -13,6 +13,7 @@ geom_rug( outside = FALSE, sides = "bl", length = unit(0.03, "npc"), + lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -101,6 +102,8 @@ bottom, and left.} \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{lineend}{Line end style (round, butt, square).} + \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_spoke.Rd b/man/geom_spoke.Rd index ea28f601c1..3ce8370834 100644 --- a/man/geom_spoke.Rd +++ b/man/geom_spoke.Rd @@ -11,6 +11,10 @@ geom_spoke( stat = "identity", position = "identity", ..., + lineend = "butt", + linejoin = "round", + arrow = NULL, + arrow.fill = NULL, 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{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\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{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..7e39508bda 100644 --- a/man/geom_tile.Rd +++ b/man/geom_tile.Rd @@ -27,6 +27,7 @@ geom_rect( position = "identity", ..., linejoin = "mitre", + lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -38,6 +39,7 @@ geom_tile( stat = "identity", position = "identity", ..., + lineend = "butt", linejoin = "mitre", na.rm = FALSE, show.legend = NA, @@ -143,6 +145,8 @@ that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=borders]{borders()}}.} \item{linejoin}{Line join style (round, mitre, bevel).} + +\item{lineend}{Line end style (round, butt, square).} } \description{ \code{geom_rect()} and \code{geom_tile()} do the same thing, but are From 26f9f8f0cc213a57d1c9980069c769d6c99c20db Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 17 Oct 2024 13:09:24 +0200 Subject: [PATCH 04/12] automatically fill in parameters --- R/boilerplates.R | 25 +++++++++++++++++++++++++ R/geom-bar.R | 6 +----- R/geom-bin2d.R | 5 +---- R/geom-col.R | 5 +---- R/geom-contour.R | 10 ++++------ R/geom-crossbar.R | 6 +----- R/geom-curve.R | 7 +------ R/geom-errorbar.R | 5 +---- R/geom-errorbarh.R | 2 +- R/geom-hex.R | 5 +---- R/geom-histogram.R | 4 ++-- R/geom-linerange.R | 2 +- R/geom-path.R | 20 +++----------------- R/geom-pointrange.R | 2 +- R/geom-polygon.R | 5 +---- R/geom-quantile.R | 6 +----- R/geom-rect.R | 2 +- R/geom-rug.R | 5 +---- R/geom-segment.R | 6 +----- R/geom-spoke.R | 6 +----- R/geom-tile.R | 2 +- R/geom-violin.R | 3 ++- man/geom_bar.Rd | 11 +++++------ man/geom_contour.Rd | 14 +++++++------- man/geom_linerange.Rd | 25 ++++++++++++------------- man/geom_path.Rd | 20 ++++++++++---------- man/geom_quantile.Rd | 14 +++++++------- man/geom_rug.Rd | 10 +++++----- man/geom_spoke.Rd | 12 ++++++------ man/geom_tile.Rd | 6 +++--- man/geom_violin.Rd | 8 ++++---- 31 files changed, 112 insertions(+), 147 deletions(-) diff --git a/R/boilerplates.R b/R/boilerplates.R index 26d8030aeb..8987e9e451 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -23,6 +23,31 @@ boilerplate.Geom <- function(x, ..., env = caller_env()) { 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())) + 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] + } + } + 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 <- list2( mapping = args$mapping, diff --git a/R/geom-bar.R b/R/geom-bar.R index 97fb689ced..2d877ce8a3 100644 --- a/R/geom-bar.R +++ b/R/geom-bar.R @@ -136,8 +136,4 @@ GeomBar <- ggproto("GeomBar", GeomRect, #' 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 <- boilerplate( - GeomBar, stat = "count", position = "stack", - just = 0.5, orientation = NA, - lineend = "butt", linejoin = "mitre" -) +geom_bar <- boilerplate(GeomBar, stat = "count", position = "stack", just = 0.5) diff --git a/R/geom-bin2d.R b/R/geom-bin2d.R index 4e401655f6..4313b28471 100644 --- a/R/geom-bin2d.R +++ b/R/geom-bin2d.R @@ -31,10 +31,7 @@ NULL #' #' # Or by specifying the width of the bins #' d + geom_bin_2d(binwidth = c(0.1, 0.1)) -geom_bin_2d <- boilerplate( - GeomTile, stat = "bin2d", - lineend = "butt", linejoin = "mitre" -) +geom_bin_2d <- boilerplate(GeomTile, stat = "bin2d") #' @export #' @rdname geom_bin_2d diff --git a/R/geom-col.R b/R/geom-col.R index 3ce9ad55fd..f779fb6e3a 100644 --- a/R/geom-col.R +++ b/R/geom-col.R @@ -1,9 +1,6 @@ #' @export #' @rdname geom_bar -geom_col <- boilerplate( - GeomBar, position = "stack", - just = 0.5, lineend = "butt", linejoin = "mitre" -) +geom_col <- boilerplate(GeomBar, position = "stack", just = 0.5) #' @rdname ggplot2-ggproto #' @format NULL diff --git a/R/geom-contour.R b/R/geom-contour.R index 51f9316d13..5913d558bf 100644 --- a/R/geom-contour.R +++ b/R/geom-contour.R @@ -85,16 +85,14 @@ GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon) #' } geom_contour <- boilerplate( GeomContour, stat = "contour", - bins = NULL, binwidth = NULL, breaks = NULL, - lineend = "butt", linejoin = "round", linemitre = 10, - arrow = NULL, arrow.fill = NULL + # Passed to contour stat: + bins = NULL, binwidth = NULL, breaks = NULL ) #' @rdname geom_contour #' @export geom_contour_filled <- boilerplate( GeomContourFilled, stat = "contour_filled", - bins = NULL, binwidth = NULL, breaks = NULL, - rule = "evenodd", - lineend = "butt", linejoin = "round", linemitre = 10 + # Passed to contour_filled stat: + bins = NULL, binwidth = NULL, breaks = NULL ) diff --git a/R/geom-crossbar.R b/R/geom-crossbar.R index bd32f7b9c6..288f5396c5 100644 --- a/R/geom-crossbar.R +++ b/R/geom-crossbar.R @@ -93,8 +93,4 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom, #' @export #' @rdname geom_linerange -geom_crossbar <- boilerplate( - GeomCrossbar, - fatten = 2.5, orientation = NA, width = NULL, - lineend = "butt", linejoin = "mitre" -) +geom_crossbar <- boilerplate(GeomCrossbar) diff --git a/R/geom-curve.R b/R/geom-curve.R index dd95a1deab..2ddac968fc 100644 --- a/R/geom-curve.R +++ b/R/geom-curve.R @@ -47,9 +47,4 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment, #' @inheritParams grid::curveGrob #' @export #' @rdname geom_segment -geom_curve <- boilerplate( - GeomCurve, - curvature = 0.5, angle = 90, ncp = 5, - arrow = NULL, arrow.fill = NULL, - lineend = "butt" -) +geom_curve <- boilerplate(GeomCurve) diff --git a/R/geom-errorbar.R b/R/geom-errorbar.R index 1d57ac5c83..05deae5886 100644 --- a/R/geom-errorbar.R +++ b/R/geom-errorbar.R @@ -58,7 +58,4 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom, #' @export #' @rdname geom_linerange -geom_errorbar <- boilerplate( - GeomErrorbar, - orientation = NA, lineend = "butt" -) +geom_errorbar <- boilerplate(GeomErrorbar, orientation = NA) diff --git a/R/geom-errorbarh.R b/R/geom-errorbarh.R index 9695ce1428..96e5cdc412 100644 --- a/R/geom-errorbarh.R +++ b/R/geom-errorbarh.R @@ -69,4 +69,4 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom, #' p + #' geom_point() + #' geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2)) -geom_errorbarh <- boilerplate(GeomErrorbarh, lineend = "butt") +geom_errorbarh <- boilerplate(GeomErrorbarh) diff --git a/R/geom-hex.R b/R/geom-hex.R index f0ccd557f0..0f43a90ac7 100644 --- a/R/geom-hex.R +++ b/R/geom-hex.R @@ -100,7 +100,4 @@ GeomHex <- ggproto("GeomHex", Geom, #' d + geom_hex(binwidth = c(1, 1000)) #' d + geom_hex(binwidth = c(.1, 500)) #' } -geom_hex <- boilerplate( - GeomHex, stat = 'binhex', - lineend = "butt", linejoin = "mitre", linemitre = 10 -) +geom_hex <- boilerplate(GeomHex, stat = 'binhex') diff --git a/R/geom-histogram.R b/R/geom-histogram.R index 07ec01de2d..15c8064264 100644 --- a/R/geom-histogram.R +++ b/R/geom-histogram.R @@ -117,6 +117,6 @@ #' geom_histogram(binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3))) geom_histogram <- boilerplate( GeomBar, stat = "bin", position = "stack", - binwidth = NULL, bins = NULL, orientation = NA, - lineend = "butt", linejoin = "mitre" + # Passed to bin stat: + binwidth = NULL, bins = NULL, orientation = NA ) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index c404db4121..434078bda0 100644 --- a/R/geom-linerange.R +++ b/R/geom-linerange.R @@ -109,4 +109,4 @@ GeomLinerange <- ggproto( #' aes(ymin = lower, ymax = upper), #' position = position_dodge2(width = 0.5, padding = 0.5) #' ) -geom_linerange <- boilerplate(GeomLinerange, orientation = NA, lineend = "butt") +geom_linerange <- boilerplate(GeomLinerange, orientation = NA) diff --git a/R/geom-path.R b/R/geom-path.R index 6bcde42109..ad1bbaa890 100644 --- a/R/geom-path.R +++ b/R/geom-path.R @@ -266,32 +266,18 @@ GeomStep <- ggproto( #' # But this doesn't #' should_stop(p + geom_line(aes(colour = x), linetype=2)) #' } -geom_path <- boilerplate( - GeomPath, - lineend = "butt", linejoin = "round", linemitre = 10, - arrow = NULL, arrow.fill = NULL -) +geom_path <- boilerplate(GeomPath) #' @export #' @rdname geom_path -geom_line <- boilerplate( - GeomLine, - orientation = NA, - arrow = NULL, arrow.fill = NULL, - lineend = "butt", linejoin = "round", linemitre = 10 -) +geom_line <- boilerplate(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 <- boilerplate( - GeomStep, - direction = "hv", orientation = NA, - arrow = NULL, arrow.fill = NULL, - lineend = "butt", linejoin = "round", linemitre = 10 -) +geom_step <- boilerplate(GeomStep, orientation = NA) # Trim false values from left and right: keep all values from # first TRUE to last TRUE diff --git a/R/geom-pointrange.R b/R/geom-pointrange.R index 84d557e430..17a319b65c 100644 --- a/R/geom-pointrange.R +++ b/R/geom-pointrange.R @@ -47,4 +47,4 @@ GeomPointrange <- ggproto("GeomPointrange", Geom, #' @export #' @rdname geom_linerange -geom_pointrange <- boilerplate(GeomPointrange, fatten = 4, orientation = NA, lineend = "butt") +geom_pointrange <- boilerplate(GeomPointrange, orientation = NA) diff --git a/R/geom-polygon.R b/R/geom-polygon.R index 344db19fba..9ee85a1c7b 100644 --- a/R/geom-polygon.R +++ b/R/geom-polygon.R @@ -176,10 +176,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, #' geom_polygon(aes(fill = value, group = id, subgroup = subid)) #' p #' } -geom_polygon <- boilerplate( - GeomPolygon, rule = "evenodd", - lineend = "butt", linejoin = "round", linemitre = 10 -) +geom_polygon <- boilerplate(GeomPolygon) # Assigning pathGrob in .onLoad ensures that packages that subclass GeomPolygon # do not install with error `possible error in 'pathGrob(munched$x, munched$y, ': diff --git a/R/geom-quantile.R b/R/geom-quantile.R index 975181174f..2e12248ee5 100644 --- a/R/geom-quantile.R +++ b/R/geom-quantile.R @@ -44,8 +44,4 @@ GeomQuantile <- ggproto( #' #' # Set aesthetics to fixed value #' m + geom_quantile(colour = "red", linewidth = 2, alpha = 0.5) -geom_quantile <- boilerplate( - GeomQuantile, stat = "quantile", - lineend = "butt", linejoin = "round", linemitre = 10, - arrow = NULL, arrow.fill = NULL -) +geom_quantile <- boilerplate(GeomQuantile, stat = "quantile") diff --git a/R/geom-rect.R b/R/geom-rect.R index 4eba984433..5157597017 100644 --- a/R/geom-rect.R +++ b/R/geom-rect.R @@ -86,7 +86,7 @@ GeomRect <- ggproto("GeomRect", Geom, #' @export #' @rdname geom_tile -geom_rect <- boilerplate(GeomRect, linejoin = "mitre", lineend = "butt") +geom_rect <- boilerplate(GeomRect) resolve_rect <- function(min = NULL, max = NULL, center = NULL, length = NULL, fun, type) { diff --git a/R/geom-rug.R b/R/geom-rug.R index 4ec9645c82..3f4331d4c8 100644 --- a/R/geom-rug.R +++ b/R/geom-rug.R @@ -181,7 +181,4 @@ GeomRug <- ggproto("GeomRug", Geom, #' p + #' geom_rug(length = unit(0.05, "npc")) + #' scale_y_continuous(expand = c(0.1, 0.1)) -geom_rug <- boilerplate( - GeomRug, - outside = FALSE, sides = "bl", length = unit(0.03, "npc"), lineend = "butt" -) +geom_rug <- boilerplate(GeomRug) diff --git a/R/geom-segment.R b/R/geom-segment.R index 8884c68a39..026ac157a3 100644 --- a/R/geom-segment.R +++ b/R/geom-segment.R @@ -128,8 +128,4 @@ GeomSegment <- ggproto("GeomSegment", Geom, #' #' ggplot(counts, aes(x, Freq)) + #' geom_segment(aes(xend = x, yend = 0), linewidth = 10, lineend = "butt") -geom_segment <- boilerplate( - GeomSegment, - arrow = NULL, arrow.fill = NULL, - lineend = "butt", linejoin = "round" -) +geom_segment <- boilerplate(GeomSegment) diff --git a/R/geom-spoke.R b/R/geom-spoke.R index f20aebf66e..6ed4e89880 100644 --- a/R/geom-spoke.R +++ b/R/geom-spoke.R @@ -40,11 +40,7 @@ GeomSpoke <- ggproto( #' ggplot(df, aes(x, y)) + #' geom_point() + #' geom_spoke(aes(angle = angle, radius = speed)) -geom_spoke <- boilerplate( - GeomSpoke, - lineend = "butt", linejoin = "round", - arrow = NULL, arrow.fill = NULL -) +geom_spoke <- boilerplate(GeomSpoke) #' @export #' @rdname geom_spoke diff --git a/R/geom-tile.R b/R/geom-tile.R index b68637d396..c441e5bd52 100644 --- a/R/geom-tile.R +++ b/R/geom-tile.R @@ -117,4 +117,4 @@ GeomTile <- ggproto("GeomTile", GeomRect, #' position = "identity" #' ) #' } -geom_tile <- boilerplate(GeomTile, lineend = "butt", linejoin = "mitre") +geom_tile <- boilerplate(GeomTile) diff --git a/R/geom-violin.R b/R/geom-violin.R index 915e927727..16bdfaef1b 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -182,7 +182,8 @@ GeomViolin <- ggproto("GeomViolin", Geom, #' } geom_violin <- boilerplate( GeomViolin, stat = "ydensity", position = "dodge", - draw_quantiles = NULL, trim = TRUE, bounds = c(-Inf, Inf), scale = "area" + # arguments passed to ydensity stat: + trim = TRUE, bounds = c(-Inf, Inf), scale = "area" ) # Returns a data.frame with info needed to draw quantile segments. diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index a136df19cf..eb8855f587 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -13,7 +13,6 @@ geom_bar( position = "stack", ..., just = 0.5, - orientation = NA, lineend = "butt", linejoin = "mitre", na.rm = FALSE, @@ -115,11 +114,6 @@ 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{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).} @@ -143,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_contour.Rd b/man/geom_contour.Rd index 1758dfe88e..97d03e3a04 100644 --- a/man/geom_contour.Rd +++ b/man/geom_contour.Rd @@ -16,11 +16,11 @@ geom_contour( bins = NULL, binwidth = NULL, breaks = NULL, + 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 @@ -162,17 +162,17 @@ 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).} \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_linerange.Rd b/man/geom_linerange.Rd index 471caba518..b8171ab4ac 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -14,11 +14,10 @@ geom_crossbar( stat = "identity", position = "identity", ..., - fatten = 2.5, - orientation = NA, - width = NULL, lineend = "butt", linejoin = "mitre", + fatten = 2.5, + width = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -56,9 +55,9 @@ geom_pointrange( stat = "identity", position = "identity", ..., - fatten = 4, orientation = NA, lineend = "butt", + fatten = 4, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -139,22 +138,17 @@ 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{fatten}{A multiplicative factor used to increase the size of the middle bar in \code{geom_crossbar()} and the middle point in \code{geom_pointrange()}.} -\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{width}{Bar width. By default, set to 90\% of the \code{\link[=resolution]{resolution()}} of the data.} -\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.} @@ -170,6 +164,11 @@ 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{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{ Various ways of representing a vertical interval defined by \code{x}, diff --git a/man/geom_path.Rd b/man/geom_path.Rd index a5416ac27c..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 @@ -45,13 +45,13 @@ geom_step( stat = "identity", position = "identity", ..., - direction = "hv", orientation = NA, - arrow = NULL, - arrow.fill = NULL, lineend = "butt", linejoin = "round", linemitre = 10, + arrow = NULL, + arrow.fill = NULL, + direction = "hv", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -132,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_quantile.Rd b/man/geom_quantile.Rd index 8a80b86db9..3109da63b1 100644 --- a/man/geom_quantile.Rd +++ b/man/geom_quantile.Rd @@ -11,11 +11,11 @@ geom_quantile( stat = "quantile", 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 @@ -98,17 +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{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_rug.Rd b/man/geom_rug.Rd index 4f9a4f9250..963d1736af 100644 --- a/man/geom_rug.Rd +++ b/man/geom_rug.Rd @@ -10,10 +10,10 @@ geom_rug( stat = "identity", position = "identity", ..., - outside = FALSE, + lineend = "butt", sides = "bl", + outside = FALSE, length = unit(0.03, "npc"), - lineend = "butt", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -94,15 +94,15 @@ 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{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{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{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 a warning. If \code{TRUE}, missing values are silently removed.} diff --git a/man/geom_spoke.Rd b/man/geom_spoke.Rd index 3ce8370834..657333ac75 100644 --- a/man/geom_spoke.Rd +++ b/man/geom_spoke.Rd @@ -11,10 +11,10 @@ geom_spoke( stat = "identity", position = "identity", ..., - lineend = "butt", - linejoin = "round", arrow = NULL, arrow.fill = NULL, + lineend = "butt", + linejoin = "round", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -95,15 +95,15 @@ 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{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 7e39508bda..312357f40c 100644 --- a/man/geom_tile.Rd +++ b/man/geom_tile.Rd @@ -26,8 +26,8 @@ geom_rect( stat = "identity", position = "identity", ..., - linejoin = "mitre", lineend = "butt", + linejoin = "mitre", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -144,9 +144,9 @@ 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{linejoin}{Line join style (round, mitre, bevel).} - \item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} } \description{ \code{geom_rect()} and \code{geom_tile()} do the same thing, but are diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 97290c0cda..c3df4b9cbc 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -11,10 +11,10 @@ geom_violin( stat = "ydensity", position = "dodge", ..., - draw_quantiles = NULL, trim = TRUE, bounds = c(-Inf, Inf), scale = "area", + draw_quantiles = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE @@ -101,9 +101,6 @@ lists which parameters it can accept. \link[=draw_key]{key glyphs}, to change the display of the layer in the legend. }} -\item{draw_quantiles}{If \code{not(NULL)} (default), draw horizontal lines -at the given quantiles of the density estimate.} - \item{trim}{If \code{TRUE} (default), trim the tails of the violins to the range of the data. If \code{FALSE}, don't trim the tails.} @@ -117,6 +114,9 @@ outside of bounds are removed with a warning.} the tails). If "count", areas are scaled proportionally to the number of observations. If "width", all violins have the same maximum width.} +\item{draw_quantiles}{If \code{not(NULL)} (default), draw horizontal lines +at the given quantiles of the density estimate.} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} From 8c8f79588c0f4ba44033ed0bc3dec9d9c86ca949 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 17 Oct 2024 14:58:13 +0200 Subject: [PATCH 05/12] incorporate small checks --- R/boilerplates.R | 12 ++- R/geom-density.R | 34 ++------ R/geom-function.R | 69 ++++++--------- R/geom-raster.R | 53 ++++------- R/geom-ribbon.R | 203 ++++++++++++++++++------------------------- man/geom_density.Rd | 32 ++++--- man/geom_function.Rd | 16 ++++ man/geom_ribbon.Rd | 41 ++++++--- man/geom_tile.Rd | 8 +- 9 files changed, 209 insertions(+), 259 deletions(-) diff --git a/R/boilerplates.R b/R/boilerplates.R index 8987e9e451..499144b53f 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -8,7 +8,7 @@ boilerplate <- function(x, ...) { } #' @export -boilerplate.Geom <- function(x, ..., env = caller_env()) { +boilerplate.Geom <- function(x, ..., checks, env = caller_env()) { # Check that we can independently find the geom geom <- gsub("^geom_", "", snake_class(x)) @@ -83,7 +83,15 @@ boilerplate.Geom <- function(x, ..., env = caller_env()) { ) ) ") - body <- as.call(parse(text = body))[[1]] + body <- str2lang(body) + + checks <- substitute(checks) + if (!missing(checks)) { + if (is_call(checks, "{")) { + checks[[1]] <- NULL + } + body <- inject(quote(`{`(!!!c(checks, body)))) + } new_function(fmls, body) } diff --git a/R/geom-density.R b/R/geom-density.R index e94c5157ce..3b8ee8a317 100644 --- a/R/geom-density.R +++ b/R/geom-density.R @@ -72,31 +72,9 @@ GeomDensity <- ggproto( #' 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, - ... - ) - ) -} - - +geom_density <- boilerplate( + GeomDensity, stat = "density", + checks = { + outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) + } +) diff --git a/R/geom-function.R b/R/geom-function.R index c566731996..b2ba6df095 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 <- boilerplate( + GeomFunction, stat = "function", + checks = {data <- data %||% ensure_nonempty_data} ) diff --git a/R/geom-raster.R b/R/geom-raster.R index 94b1775373..6c4a3b92aa 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 <- boilerplate( + GeomRaster, + checks = { + check_number_decimal(hjust) + check_number_decimal(vjust) + } +) diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R index a8f6b1be42..c4e41223d1 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 @@ -266,31 +173,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 @@ -319,3 +201,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 <- boilerplate( + GeomRibbon, orientation = NA, + checks = { + outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) + } +) + +#' @rdname geom_ribbon +#' @export +geom_area <- boilerplate( + GeomArea, stat = "align", position = "stack", + orientation = NA, outline.type = "upper", + checks = { + outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) + } +) diff --git a/man/geom_density.Rd b/man/geom_density.Rd index 58f6dae9e2..1ae3ea371d 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( @@ -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,10 +126,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, 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 @@ -156,6 +159,11 @@ one plot or if you are manually adjusting the scale limits.} finite, boundary effect of default density estimation will be corrected by reflecting tails outside \code{bounds} around their closest edge. Data points outside of bounds are removed with a warning.} + +\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{ Computes and draws kernel density estimate, which is a smoothed version of 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_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_tile.Rd b/man/geom_tile.Rd index 312357f40c..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 @@ -121,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.} From fa9f6d2683e745c4c0808cbba47316f755f5d7dc Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 17 Oct 2024 15:11:18 +0200 Subject: [PATCH 06/12] document --- R/boilerplates.R | 32 ++++++++++++++++++++++++++++++++ man/boilerplate.Rd | 44 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+) create mode 100644 man/boilerplate.Rd diff --git a/R/boilerplates.R b/R/boilerplates.R index 499144b53f..aac6927508 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -2,7 +2,39 @@ #' @include scale-type.R NULL +#' Produce boilerplate constructors +#' +#' The `boilerplate()` functions sets up a user-facing constructor for ggproto +#' classes. Currently, `boilerplate()` 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 Expressions evaluated before construction of the object. +#' Can be a `{}` block to include multiple expressions. +#' +#' @return A function #' @export +#' +#' @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 <- boilerplate(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()) boilerplate <- function(x, ...) { UseMethod("boilerplate") } diff --git a/man/boilerplate.Rd b/man/boilerplate.Rd new file mode 100644 index 0000000000..313c20d3de --- /dev/null +++ b/man/boilerplate.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/boilerplates.R +\name{boilerplate} +\alias{boilerplate} +\title{Produce boilerplate constructors} +\usage{ +boilerplate(x, ...) +} +\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}{Expressions evaluated before construction of the object. +Can be a \code{{}} block to include multiple expressions.} +} +\value{ +A function +} +\description{ +The \code{boilerplate()} functions sets up a user-facing constructor for ggproto +classes. Currently, \code{boilerplate()} 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 <- boilerplate(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()) +} From 075ea86cb114db1a10684d525c84cbb4a68ea0eb Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 17 Oct 2024 15:11:28 +0200 Subject: [PATCH 07/12] accept visual snapshots --- .../_snaps/geom-polygon/open-and-closed-munched-polygons.svg | 4 ++-- tests/testthat/_snaps/position-stack/area-stacking.svg | 4 ++-- .../testthat/_snaps/stat-align/align-two-areas-with-cliff.svg | 4 ++-- .../_snaps/stat-align/align-two-areas-with-pos-neg-y.svg | 4 ++-- tests/testthat/_snaps/stat-align/align-two-areas.svg | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) 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 b970c9f317..113d1e45b1 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 From ea572007317bc471e887bffba87e81c0d1e58cf3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 18 Oct 2024 09:05:47 +0200 Subject: [PATCH 08/12] Update R/boilerplates.R Thanks June! Co-authored-by: June Choe <52832839+yjunechoe@users.noreply.github.com> --- R/boilerplates.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/boilerplates.R b/R/boilerplates.R index aac6927508..29a9101349 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -81,12 +81,12 @@ boilerplate.Geom <- function(x, ..., checks, env = caller_env()) { } # Build function formals - fmls <- list2( + fmls <- rlang::pairlist2( mapping = args$mapping, data = args$data, stat = args$stat %||% "identity", position = args$position %||% "identity", - `...` = quote(expr = ), + `...` = rlang::missing_arg(), !!!args[extra_args], na.rm = args$na.rm %||% FALSE, show.legend = args$show.legend %||% NA, From 6b44f331fb4d6e966c960d5cc496f1a073bab82a Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 18 Oct 2024 09:35:37 +0200 Subject: [PATCH 09/12] Adopt advice from June --- R/boilerplates.R | 50 +++++++++++++++++++--------------------------- R/geom-density.R | 5 +++-- R/geom-function.R | 2 +- R/geom-raster.R | 6 +++--- R/geom-ribbon.R | 8 ++++---- man/boilerplate.Rd | 4 ++-- 6 files changed, 33 insertions(+), 42 deletions(-) diff --git a/R/boilerplates.R b/R/boilerplates.R index 29a9101349..810b239a6e 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -10,8 +10,8 @@ NULL #' @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 Expressions evaluated before construction of the object. -#' Can be a `{}` block to include multiple expressions. +#' @param checks A list of calls to be evaluated before construction of the +#' object, such as one constructed with [`exprs()`][rlang::exprs()]. #' #' @return A function #' @export @@ -40,7 +40,7 @@ boilerplate <- function(x, ...) { } #' @export -boilerplate.Geom <- function(x, ..., checks, env = caller_env()) { +boilerplate.Geom <- function(x, ..., checks = NULL, env = caller_env()) { # Check that we can independently find the geom geom <- gsub("^geom_", "", snake_class(x)) @@ -81,46 +81,36 @@ boilerplate.Geom <- function(x, ..., checks, env = caller_env()) { } # Build function formals - fmls <- rlang::pairlist2( + fmls <- pairlist2( mapping = args$mapping, data = args$data, stat = args$stat %||% "identity", position = args$position %||% "identity", - `...` = rlang::missing_arg(), + `...` = missing_arg(), !!!args[extra_args], na.rm = args$na.rm %||% FALSE, show.legend = args$show.legend %||% NA, inherit.aes = args$inherit.aes %||% TRUE ) - if (length(extra_args) > 0) { - extra_args <- paste0( - "\n ", extra_args, " = ", extra_args, ",", collapse = "" - ) - } + # Construct call for the 'layer(params)' argument + params <- exprs(!!!syms(c("na.rm", extra_args)), .named = TRUE) + params <- call2("list2", !!!params, quote(...)) - body <- paste0(" - layer( - data = data, - mapping = mapping, - stat = stat, - geom = \"", geom, "\", - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list2( - na.rm = na.rm,", - extra_args, " - ... - ) - ) - ") - body <- str2lang(body) + # 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) - checks <- substitute(checks) + # Prepend any checks if (!missing(checks)) { - if (is_call(checks, "{")) { - checks[[1]] <- NULL + 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 <- inject(quote(`{`(!!!c(checks, body)))) } diff --git a/R/geom-density.R b/R/geom-density.R index 3b8ee8a317..aa2a91ec77 100644 --- a/R/geom-density.R +++ b/R/geom-density.R @@ -74,7 +74,8 @@ GeomDensity <- ggproto( #' } geom_density <- boilerplate( GeomDensity, stat = "density", - checks = { + checks = exprs( outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) - } + ) ) + diff --git a/R/geom-function.R b/R/geom-function.R index b2ba6df095..179bcc0dca 100644 --- a/R/geom-function.R +++ b/R/geom-function.R @@ -87,5 +87,5 @@ GeomFunction <- ggproto("GeomFunction", GeomPath, #' @export geom_function <- boilerplate( GeomFunction, stat = "function", - checks = {data <- data %||% ensure_nonempty_data} + checks = exprs(data <- data %||% ensure_nonempty_data) ) diff --git a/R/geom-raster.R b/R/geom-raster.R index 6c4a3b92aa..aeaf821692 100644 --- a/R/geom-raster.R +++ b/R/geom-raster.R @@ -98,8 +98,8 @@ GeomRaster <- ggproto("GeomRaster", Geom, #' (the default) don't interpolate. geom_raster <- boilerplate( GeomRaster, - checks = { - check_number_decimal(hjust) + checks = exprs( + check_number_decimal(hjust), check_number_decimal(vjust) - } + ) ) diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R index c4e41223d1..9062432b20 100644 --- a/R/geom-ribbon.R +++ b/R/geom-ribbon.R @@ -272,9 +272,9 @@ GeomArea <- ggproto("GeomArea", GeomRibbon, #' geom_ribbon <- boilerplate( GeomRibbon, orientation = NA, - checks = { + checks = exprs( outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) - } + ) ) #' @rdname geom_ribbon @@ -282,7 +282,7 @@ geom_ribbon <- boilerplate( geom_area <- boilerplate( GeomArea, stat = "align", position = "stack", orientation = NA, outline.type = "upper", - checks = { + checks = exprs( outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full")) - } + ) ) diff --git a/man/boilerplate.Rd b/man/boilerplate.Rd index 313c20d3de..040f834f51 100644 --- a/man/boilerplate.Rd +++ b/man/boilerplate.Rd @@ -12,8 +12,8 @@ boilerplate(x, ...) \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}{Expressions evaluated before construction of the object. -Can be a \code{{}} block to include multiple expressions.} +\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()}}.} } \value{ A function From 6e71e1a527e013c81ce123c57b206ee63fe0038c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 18 Oct 2024 10:03:00 +0200 Subject: [PATCH 10/12] docfix --- R/boilerplates.R | 3 +++ man/boilerplate.Rd | 6 ++++++ 2 files changed, 9 insertions(+) diff --git a/R/boilerplates.R b/R/boilerplates.R index 810b239a6e..a909ea88f5 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -12,9 +12,11 @@ NULL #' 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 env An environment to search for the object. #' #' @return A function #' @export +#' @keywords internal #' #' @examples #' # For testing purposes, a geom that returns grobs @@ -40,6 +42,7 @@ boilerplate <- function(x, ...) { } #' @export +#' @rdname boilerplate boilerplate.Geom <- function(x, ..., checks = NULL, env = caller_env()) { # Check that we can independently find the geom diff --git a/man/boilerplate.Rd b/man/boilerplate.Rd index 040f834f51..f703ece6e5 100644 --- a/man/boilerplate.Rd +++ b/man/boilerplate.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/boilerplates.R \name{boilerplate} \alias{boilerplate} +\alias{boilerplate.Geom} \title{Produce boilerplate constructors} \usage{ boilerplate(x, ...) + +\method{boilerplate}{Geom}(x, ..., checks = NULL, env = caller_env()) } \arguments{ \item{x}{An object to setup a constructor for.} @@ -14,6 +17,8 @@ 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{env}{An environment to search for the object.} } \value{ A function @@ -42,3 +47,4 @@ p <- ggplot(mtcars, aes(disp, mpg)) p + geom_test() p + geom_test(grob = grid::circleGrob()) } +\keyword{internal} From d488de8341220cce772cc4146c25ffc72be3f857 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 18 Oct 2024 21:36:08 +0200 Subject: [PATCH 11/12] Apply suggestions from code review Co-authored-by: June Choe <52832839+yjunechoe@users.noreply.github.com> --- R/boilerplates.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/boilerplates.R b/R/boilerplates.R index a909ea88f5..111786a722 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -115,8 +115,8 @@ boilerplate.Geom <- function(x, ..., checks = NULL, env = caller_env()) { with {.fn rlang::exprs}." ) } - body <- inject(quote(`{`(!!!c(checks, body)))) + body <- call2("{", !!!checks, body) } - new_function(fmls, body) + new_function(fmls, body, env = caller_env()) } From e6db72d6426b02b869622eb4ba4839c31391d0c4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 21 Oct 2024 11:17:10 +0200 Subject: [PATCH 12/12] ensure `list2()` can be found --- R/boilerplates.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/boilerplates.R b/R/boilerplates.R index 111786a722..71e5318929 100644 --- a/R/boilerplates.R +++ b/R/boilerplates.R @@ -118,5 +118,8 @@ boilerplate.Geom <- function(x, ..., checks = NULL, env = caller_env()) { body <- call2("{", !!!checks, body) } - new_function(fmls, body, env = caller_env()) + # We encapsulate rlang::list2 + new_env <- new_environment(list(list2 = list2), env) + + new_function(fmls, body, env = new_env) }