1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
# Regex to determine if an identifier refers to a calculated aesthetic
match_calculated_aes <- "^\\.\\.([a-zA-Z._]+)\\.\\.$"
# Determine if aesthetic is calculated
is_calculated_aes <- function(aesthetics) {
vars <- lapply(aesthetics, find_vars)
vapply(vars, function(x) any(grepl(match_calculated_aes, x)), logical(1))
}
find_vars <- function(expr) {
if (is.name(expr)) {
as.character(expr)
} else if (is.atomic(expr)) {
character()
} else if (is.call(expr)) {
unlist(lapply(expr[-1], find_vars))
} else if (is.pairlist(expr)) {
# In the unlikely event of an anonymous function
unlist(lapply(expr, find_vars))
} else {
stop("Unknown input:", class(expr)[1])
}
}
# Strip dots from expressions
strip_dots <- function(expr) {
if (is.atomic(expr)) {
expr
} else if (is.name(expr)) {
as.name(gsub(match_calculated_aes, "\\1", as.character(expr)))
} else if (is.call(expr)) {
expr[-1] <- lapply(expr[-1], strip_dots)
expr
} else if (is.pairlist(expr)) {
# In the unlikely event of an anonymous function
as.pairlist(lapply(expr, expr))
} else if (is.list(expr)) {
# For list of aesthetics
lapply(expr, strip_dots)
} else {
stop("Unknown input:", class(expr)[1])
}
}
|
