Skip to content

Commit 8c8f795

Browse files
teunbrandteunbrand
committed
incorporate small checks
1 parent 26f9f8f commit 8c8f795

File tree

9 files changed

+209
-259
lines changed

9 files changed

+209
-259
lines changed

‎R/boilerplates.R

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ boilerplate <- function(x, ...) {
88
}
99

1010
#' @export
11-
boilerplate.Geom <- function(x, ..., env = caller_env()) {
11+
boilerplate.Geom <- function(x, ..., checks, env = caller_env()) {
1212

1313
# Check that we can independently find the geom
1414
geom <- gsub("^geom_", "", snake_class(x))
@@ -83,7 +83,15 @@ boilerplate.Geom <- function(x, ..., env = caller_env()) {
8383
)
8484
)
8585
")
86-
body <- as.call(parse(text = body))[[1]]
86+
body <- str2lang(body)
87+
88+
checks <- substitute(checks)
89+
if (!missing(checks)) {
90+
if (is_call(checks, "{")) {
91+
checks[[1]] <- NULL
92+
}
93+
body <- inject(quote(`{`(!!!c(checks, body))))
94+
}
8795

8896
new_function(fmls, body)
8997
}

‎R/geom-density.R

Lines changed: 6 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -72,31 +72,9 @@ GeomDensity <- ggproto(
7272
#' ggplot(diamonds, aes(carat, after_stat(count), fill = cut)) +
7373
#' geom_density(position = "fill")
7474
#' }
75-
geom_density <- function(mapping = NULL, data = NULL,
76-
stat = "density", position = "identity",
77-
...,
78-
na.rm = FALSE,
79-
orientation = NA,
80-
show.legend = NA,
81-
inherit.aes = TRUE,
82-
outline.type = "upper") {
83-
outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full"))
84-
85-
layer(
86-
data = data,
87-
mapping = mapping,
88-
stat = stat,
89-
geom = GeomDensity,
90-
position = position,
91-
show.legend = show.legend,
92-
inherit.aes = inherit.aes,
93-
params = list2(
94-
na.rm = na.rm,
95-
orientation = orientation,
96-
outline.type = outline.type,
97-
...
98-
)
99-
)
100-
}
101-
102-
75+
geom_density <- boilerplate(
76+
GeomDensity, stat = "density",
77+
checks = {
78+
outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full"))
79+
}
80+
)

‎R/geom-function.R

Lines changed: 26 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,26 @@
1+
#' @rdname ggplot2-ggproto
2+
#' @format NULL
3+
#' @usage NULL
4+
#' @export
5+
#' @include geom-path.R
6+
GeomFunction <- ggproto("GeomFunction", GeomPath,
7+
draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
8+
lineend = "butt", linejoin = "round", linemitre = 10,
9+
na.rm = FALSE) {
10+
groups <- unique0(data$group)
11+
if (length(groups) > 1) {
12+
cli::cli_warn(c(
13+
"Multiple drawing groups in {.fn {snake_class(self)}}",
14+
"i" = "Did you use the correct {.field group}, {.field colour}, or {.field fill} aesthetics?"
15+
))
16+
}
17+
18+
ggproto_parent(GeomPath, self)$draw_panel(
19+
data, panel_params, coord, arrow, arrow.fill, lineend, linejoin, linemitre, na.rm
20+
)
21+
}
22+
)
23+
124
#' Draw a function as a continuous curve
225
#'
326
#' Computes and draws a function as a continuous curve. This makes it easy to
@@ -62,47 +85,7 @@
6285
#' geom_function(fun = dnorm, colour = "red", xlim=c(-7, 7))
6386
#'
6487
#' @export
65-
geom_function <- function(mapping = NULL, data = NULL, stat = "function",
66-
position = "identity", ..., na.rm = FALSE,
67-
show.legend = NA, inherit.aes = TRUE) {
68-
if (is.null(data)) {
69-
data <- ensure_nonempty_data
70-
}
71-
72-
layer(
73-
data = data,
74-
mapping = mapping,
75-
stat = stat,
76-
geom = GeomFunction,
77-
position = position,
78-
show.legend = show.legend,
79-
inherit.aes = inherit.aes,
80-
params = list2(
81-
na.rm = na.rm,
82-
...
83-
)
84-
)
85-
}
86-
87-
#' @rdname ggplot2-ggproto
88-
#' @format NULL
89-
#' @usage NULL
90-
#' @export
91-
#' @include geom-path.R
92-
GeomFunction <- ggproto("GeomFunction", GeomPath,
93-
draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
94-
lineend = "butt", linejoin = "round", linemitre = 10,
95-
na.rm = FALSE) {
96-
groups <- unique0(data$group)
97-
if (length(groups) > 1) {
98-
cli::cli_warn(c(
99-
"Multiple drawing groups in {.fn {snake_class(self)}}",
100-
"i" = "Did you use the correct {.field group}, {.field colour}, or {.field fill} aesthetics?"
101-
))
102-
}
103-
104-
ggproto_parent(GeomPath, self)$draw_panel(
105-
data, panel_params, coord, arrow, arrow.fill, lineend, linejoin, linemitre, na.rm
106-
)
107-
}
88+
geom_function <- boilerplate(
89+
GeomFunction, stat = "function",
90+
checks = {data <- data %||% ensure_nonempty_data}
10891
)

‎R/geom-raster.R

Lines changed: 15 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1,44 +1,6 @@
11
#' @include geom-.R
22
NULL
33

4-
#' @export
5-
#' @rdname geom_tile
6-
#' @param hjust,vjust horizontal and vertical justification of the grob. Each
7-
#' justification value should be a number between 0 and 1. Defaults to 0.5
8-
#' for both, centering each pixel over its data location.
9-
#' @param interpolate If `TRUE` interpolate linearly, if `FALSE`
10-
#' (the default) don't interpolate.
11-
geom_raster <- function(mapping = NULL, data = NULL,
12-
stat = "identity", position = "identity",
13-
...,
14-
hjust = 0.5,
15-
vjust = 0.5,
16-
interpolate = FALSE,
17-
na.rm = FALSE,
18-
show.legend = NA,
19-
inherit.aes = TRUE)
20-
{
21-
check_number_decimal(hjust)
22-
check_number_decimal(vjust)
23-
24-
layer(
25-
data = data,
26-
mapping = mapping,
27-
stat = stat,
28-
geom = GeomRaster,
29-
position = position,
30-
show.legend = show.legend,
31-
inherit.aes = inherit.aes,
32-
params = list2(
33-
hjust = hjust,
34-
vjust = vjust,
35-
interpolate = interpolate,
36-
na.rm = na.rm,
37-
...
38-
)
39-
)
40-
}
41-
424
#' @rdname ggplot2-ggproto
435
#' @format NULL
446
#' @usage NULL
@@ -126,3 +88,18 @@ GeomRaster <- ggproto("GeomRaster", Geom,
12688
},
12789
draw_key = draw_key_rect
12890
)
91+
92+
#' @export
93+
#' @rdname geom_tile
94+
#' @param hjust,vjust horizontal and vertical justification of the grob. Each
95+
#' justification value should be a number between 0 and 1. Defaults to 0.5
96+
#' for both, centering each pixel over its data location.
97+
#' @param interpolate If `TRUE` interpolate linearly, if `FALSE`
98+
#' (the default) don't interpolate.
99+
geom_raster <- boilerplate(
100+
GeomRaster,
101+
checks = {
102+
check_number_decimal(hjust)
103+
check_number_decimal(vjust)
104+
}
105+
)

0 commit comments

Comments
 (0)