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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
new_bench_expr <- function(x, description = names(x)) {
if (is.null(description)) {
description <- rep("", length(x))
}
names(x) <- description
structure(x, class = c("bench_expr", "list"), description = description)
}
#' @export
format.bench_expr <- function(x, ...) {
desc <- attr(x, "description")
is_missing <- desc == ""
desc[is_missing] <- vapply(x[is_missing], deparse_trunc, character(1))
desc
}
#' @export
as.character.bench_expr <- format.bench_expr
#' @export
print.bench_expr <- function(x, ...) {
x <- unclass(x)
NextMethod()
}
#' @export
type_sum.bench_expr <- function(x) {
"bch:expr"
}
#' @export
`[.bench_expr` <- function(x, i, ...) {
new_x <- NextMethod("[")
new_bench_expr(new_x)
}
# Lazily registered in `.onLoad()`
vec_proxy.bench_expr <- function(x, ...) {
desc <- attr(x, "description")
attributes(x) <- NULL
out <- list(x = x, desc = desc)
vctrs::new_data_frame(out, n = length(x))
}
# Lazily registered in `.onLoad()`
vec_restore.bench_expr <- function(x, to, ...) {
new_bench_expr(x$x, x$desc)
}
#' @export
pillar_shaft.bench_expr <- function(x, ...) {
# We format bench expressions exactly like character vectors. This ensures
# they are truncated as needed, which is useful for long unnamed expressions
# (#94). This is the same logic as `pillar:::pillar_shaft.factor()`.
pillar_shaft(as.character(x), ...)
}
# Lazily registered in `.onLoad()`
scale_type.bench_expr <- function(x) {
"bench_expr"
}
setOldClass(c("bench_expr", "list"), list())
#' Position and color scales for bench_expr data
#'
#' Default scales for the `bench_expr` class, these are added to plots using
#' `bench_expr` objects automatically.
#' @name scale_bench_expr
#' @keywords internal
#' @export
scale_x_bench_expr <- function(...) {
sc <- ggplot2::scale_x_discrete(...)
sc$transform <- as.character
sc
}
#' @rdname scale_bench_expr
#' @keywords internal
#' @export
scale_y_bench_expr <- function(...) {
sc <- ggplot2::scale_y_discrete(...)
sc$transform <- as.character
sc
}
#' @rdname scale_bench_expr
#' @keywords internal
#' @export
scale_colour_bench_expr <- function(
palette = scales::hue_pal(...),
...,
aesthetics = "colour"
) {
sc <- ggplot2::discrete_scale(aesthetics, "bench_expr", palette, ...)
sc$transform <- as.character
sc
}
#' @rdname scale_bench_expr
#' @keywords internal
#' @export
scale_color_bench_expr <- scale_colour_bench_expr
|
