Skip to content

Commit 12f8d7c

Browse files
thomasp85thomasp85
committed
Fix #276 
1 parent 57163a1 commit 12f8d7c

31 files changed

+218
-269
lines changed

‎NAMESPACE

+2
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@ S3method(makeContent,ellip_enc)
66
S3method(makeContent,hull_enc)
77
S3method(makeContent,rect_enc)
88
S3method(makeContent,shape)
9+
S3method(single_val,default)
10+
S3method(single_val,factor)
911
S3method(widthDetails,mark_label)
1012
export(FacetCol)
1113
export(FacetGridPaginate)

‎R/arc.R

+3-2
Original file line numberDiff line numberDiff line change
@@ -208,7 +208,7 @@ GeomArc0 <- ggproto('GeomArc0', Geom,
208208
cli::cli_abort('{.fn {snake_class(self)}} is not implemented for non-linear coordinates')
209209
}
210210
trans <- coord$transform(data, panel_scales)
211-
do.call(gList, lapply(seq_len(nrow(trans)), function(i) {
211+
grobs <- lapply(seq_len(nrow(trans)), function(i) {
212212
curveGrob(trans$x[i], trans$y[i], trans$xend[i], trans$yend[i],
213213
default.units = 'native',
214214
curvature = data$curvature[i], angle = 90, ncp = ncp, square = FALSE,
@@ -220,7 +220,8 @@ GeomArc0 <- ggproto('GeomArc0', Geom,
220220
lineend = trans$lineend[i]
221221
), arrow = arrow[i]
222222
)
223-
}))
223+
})
224+
inject(gList(!!!grobs))
224225
},
225226
rename_size = TRUE,
226227
non_missing_aes = "size"

‎R/arc_bar.R

+12-12
Original file line numberDiff line numberDiff line change
@@ -141,11 +141,11 @@ StatPie <- ggproto('StatPie', Stat,
141141
))
142142
}
143143
angles <- angles / max(angles) * (2 * pi - max(seps))
144-
new_data_frame(c(df, list(
144+
data_frame0(
145+
df,
145146
start = c(0, angles[-length(angles)]) + c(0, seps[-length(seps)]) + sep / 2,
146-
end = angles + seps - sep / 2,
147-
stringsAsFactors = FALSE
148-
)))
147+
end = angles + seps - sep / 2
148+
)
149149
})
150150
arcPaths(as.data.frame(data), n)
151151
},
@@ -203,28 +203,28 @@ arcPaths <- function(data, n) {
203203
extraData <- !names(data) %in% c('r0', 'r', 'start', 'end', 'group')
204204
data$group <- make_unique(as.character(data$group))
205205
paths <- lapply(seq_len(nrow(data)), function(i) {
206-
path <- data.frame(
206+
path <- data_frame0(
207207
a = seq(data$start[i], data$end[i], length.out = data$nControl[i]),
208208
r = data$r[i]
209209
)
210210
if ('r0' %in% names(data)) {
211211
if (data$r0[i] != 0) {
212-
path <- rbind(
212+
path <- vec_rbind(
213213
path,
214-
data.frame(a = rev(path$a), r = data$r0[i])
214+
data_frame0(a = rev(path$a), r = data$r0[i])
215215
)
216216
} else {
217-
path <- rbind(
217+
path <- vec_rbind(
218218
path,
219-
data.frame(a = data$start[i], r = 0)
219+
data_frame0(a = data$start[i], r = 0)
220220
)
221221
}
222222
}
223223
path$group <- data$group[i]
224224
path$index <- seq(0, 1, length.out = nrow(path))
225225
path <- cbind(path, data[rep(i, nrow(path)), extraData, drop = FALSE])
226226
})
227-
paths <- do.call(rbind, paths)
227+
paths <- vec_rbind(!!!paths)
228228
paths <- cbind(
229229
paths[, !names(paths) %in% c('r', 'a')],
230230
trans$transform(paths$r, paths$a)
@@ -271,7 +271,7 @@ arcPaths2 <- function(data, n) {
271271
if (data$end[i[1]] == data$end[i[2]]) return()
272272
nControl <- ceiling(fullCirc * abs(diff(data$end[i])))
273273
if (nControl < 3) nControl <- 3
274-
path <- data.frame(
274+
path <- data_frame0(
275275
a = seq(data$end[i[1]], data$end[i[2]], length.out = nControl),
276276
r = data$r[i[1]],
277277
x0 = data$x0[i[1]],
@@ -288,7 +288,7 @@ arcPaths2 <- function(data, n) {
288288
}
289289
path
290290
})
291-
paths <- do.call(rbind, paths)
291+
paths <- vec_rbind(!!!paths)
292292
paths <- cbind(
293293
paths[, !names(paths) %in% c('r', 'a')],
294294
trans$transform(paths$r, paths$a)

‎R/autodensity.R

+5-4
Original file line numberDiff line numberDiff line change
@@ -57,15 +57,16 @@ StatAutodensity <- ggproto('StatAutodensity', StatDensity,
5757
n = 512, trim = FALSE, na.rm = FALSE, panel_range = list(), panel_count = list()) {
5858
if (scales$x$is_discrete()) {
5959
bins <- split(data, factor(data$x, levels = seq_len(scales$x$range_c$range[2])))
60-
binned <- rbind_dfs(lapply(as.integer(names(bins)), function(x) {
60+
binned <- lapply(as.integer(names(bins)), function(x) {
6161
count <- nrow(bins[[x]])
6262
pad <- if (count == 0) 0.5 else 0.3
6363
pad <- pad * c(-1, 1)
64-
new_data_frame(list(
64+
data_frame0(
6565
x = x + pad,
6666
density = count / nrow(data)
67-
))
68-
}))
67+
)
68+
})
69+
binned <- ved_rbind(!!!binned)
6970
binned$scaled <- binned$density / max(binned$density)
7071
binned$ndensity <- binned$density / max(binned$density)
7172
binned$count <- binned$density * nrow(data)

‎R/autohistogram.R

+5-4
Original file line numberDiff line numberDiff line change
@@ -80,15 +80,16 @@ StatAutobin <- ggproto('StatAutobin', StatBin,
8080
origin = NULL, right = NULL, drop = NULL,
8181
width = NULL) {
8282
if (scales$x$is_discrete()) {
83-
binned <- rbind_dfs(lapply(split(data, data$x), function(d) {
84-
new_data_frame(list(
83+
binned <- lapply(split(data, data$x), function(d) {
84+
data_frame0(
8585
count = nrow(d),
8686
x = d$x[1],
8787
xmin = d$x[1] - 0.5,
8888
xmax = d$x[1] + 0.5,
8989
width = 1
90-
))
91-
}))
90+
)
91+
})
92+
binned <- vec_rbind(!!!binned)
9293
binned$density <- binned$count / sum(binned$count)
9394
binned$ncount <- binned$count / max(binned$count)
9495
binned$ndensity <- binned$density / max(binned$density)

‎R/bezier.R

+9-9
Original file line numberDiff line numberDiff line change
@@ -107,14 +107,14 @@ StatBezier <- ggproto('StatBezier', Stat,
107107
))
108108
}
109109
data <- data[order(data$group), ]
110-
groups <- unique(data$group)
110+
groups <- unique0(data$group)
111111
paths <- getBeziers(data$x, data$y, match(data$group, groups), n)
112-
paths <- data.frame(
112+
paths <- data_frame0(
113113
x = paths$paths[, 1], y = paths$paths[, 2],
114114
group = groups[paths$pathID]
115115
)
116116
paths$index <- rep(seq(0, 1, length.out = n), length(nControls))
117-
dataIndex <- rep(match(unique(data$group), data$group), each = n)
117+
dataIndex <- rep(match(unique0(data$group), data$group), each = n)
118118
cbind(
119119
paths,
120120
data[dataIndex, !names(data) %in% c('x', 'y', 'group'), drop = FALSE]
@@ -165,20 +165,20 @@ StatBezier2 <- ggproto('StatBezier2', Stat,
165165
i = 'Make sure each group consists of 3 or 4 rows'
166166
))
167167
}
168-
groups <- unique(data$group)
168+
groups <- unique0(data$group)
169169
paths <- getBeziers(data$x, data$y, match(data$group, groups), params$n)
170-
paths <- data.frame(
170+
paths <- data_frame0(
171171
x = paths$paths[, 1], y = paths$paths[, 2],
172172
group = groups[paths$pathID]
173173
)
174174
paths$index <- rep(seq(0, 1, length.out = params$n), length(nControls))
175-
dataIndex <- rep(match(unique(data$group), data$group), each = params$n)
175+
dataIndex <- rep(match(unique0(data$group), data$group), each = params$n)
176176
paths <- cbind(paths, data[dataIndex, 'PANEL', drop = FALSE])
177177
extraCols <- !names(data) %in% c('x', 'y', 'group', 'PANEL')
178178
startIndex <- c(1, cumsum(nControls) + 1)[-(length(nControls) + 1)]
179179
endIndex <- c(startIndex[-1] - 1, nrow(data))
180180
dataIndex <- c(startIndex, endIndex)
181-
pathIndex <- match(unique(data$group), paths$group)
181+
pathIndex <- match(unique0(data$group), paths$group)
182182
pathIndex <- c(pathIndex, pathIndex + 1)
183183
paths$.interp <- TRUE
184184
paths$.interp[pathIndex] <- FALSE
@@ -257,9 +257,9 @@ GeomBezier0 <- ggproto('GeomBezier0', GeomPath,
257257
na.rm = FALSE) {
258258
coords <- coord$transform(data, panel_scales)
259259
if (!is.integer(coords$group)) {
260-
coords$group <- match(coords$group, unique(coords$group))
260+
coords$group <- match(coords$group, unique0(coords$group))
261261
}
262-
startPoint <- match(unique(coords$group), coords$group)
262+
startPoint <- match(unique0(coords$group), coords$group)
263263
bezierGrob(coords$x, coords$y,
264264
id = coords$group, default.units = 'native',
265265
arrow = arrow,

‎R/bspline.R

+11-11
Original file line numberDiff line numberDiff line change
@@ -96,18 +96,18 @@ StatBspline <- ggproto('StatBspline', Stat,
9696
compute_layer = function(self, data, params, panels) {
9797
if (is.null(data)) return(data)
9898
data <- data[order(data$group), ]
99-
groups <- unique(data$group)
99+
groups <- unique0(data$group)
100100
paths <- getSplines(data$x, data$y, match(data$group, groups), params$n,
101101
params$type %||% 'clamped')
102-
paths <- data.frame(
102+
paths <- data_frame0(
103103
x = paths$paths[, 1], y = paths$paths[, 2],
104104
group = groups[paths$pathID]
105105
)
106106
paths$index <- rep(
107107
seq(0, 1, length.out = params$n),
108-
length(unique(data$group))
108+
length(unique0(data$group))
109109
)
110-
dataIndex <- rep(match(unique(data$group), data$group), each = params$n)
110+
dataIndex <- rep(match(unique0(data$group), data$group), each = params$n)
111111
cbind(
112112
paths,
113113
data[dataIndex, !names(data) %in% c('x', 'y', 'group'), drop = FALSE]
@@ -152,21 +152,21 @@ StatBspline2 <- ggproto('StatBspline2', Stat,
152152
if (is.null(data)) return(data)
153153
data <- data[order(data$group), ]
154154
nControls <- table(data$group)
155-
groups <- unique(data$group)
155+
groups <- unique0(data$group)
156156
paths <- getSplines(data$x, data$y, match(data$group, groups), params$n,
157157
params$type %||% 'clamped')
158-
paths <- data.frame(
158+
paths <- data_frame0(
159159
x = paths$paths[, 1], y = paths$paths[, 2],
160160
group = groups[paths$pathID]
161161
)
162162
paths$index <- rep(
163163
seq(0, 1, length.out = params$n),
164-
length(unique(data$group))
164+
length(unique0(data$group))
165165
)
166-
dataIndex <- rep(match(unique(data$group), data$group), each = params$n)
166+
dataIndex <- rep(match(unique0(data$group), data$group), each = params$n)
167167
paths <- cbind(paths, data[dataIndex, 'PANEL', drop = FALSE])
168168
extraCols <- !names(data) %in% c('x', 'y', 'group', 'PANEL')
169-
pathIndex <- match(unique(data$group), paths$group)
169+
pathIndex <- match(unique0(data$group), paths$group)
170170
pathIndex <- unlist(Map(seq, from = pathIndex, length.out = nControls))
171171
paths$.interp <- TRUE
172172
paths$.interp[pathIndex] <- FALSE
@@ -219,9 +219,9 @@ GeomBspline0 <- ggproto('GeomBspline0', GeomPath,
219219
linemitre = 1, na.rm = FALSE) {
220220
coords <- coord$transform(data, panel_scales)
221221
if (!is.integer(coords$group)) {
222-
coords$group <- match(coords$group, unique(coords$group))
222+
coords$group <- match(coords$group, unique0(coords$group))
223223
}
224-
startPoint <- match(unique(coords$group), coords$group)
224+
startPoint <- match(unique0(coords$group), coords$group)
225225
xsplineGrob(coords$x, coords$y,
226226
id = coords$group, default.units = 'native',
227227
shape = 1, arrow = arrow, repEnds = type == 'clamped',

‎R/bspline_closed.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -94,9 +94,9 @@ GeomBsplineClosed0 <- ggproto('GeomBspline0', GeomPolygon,
9494
draw_panel = function(data, panel_scales, coord, na.rm = FALSE) {
9595
coords <- coord$transform(data, panel_scales)
9696
if (!is.integer(coords$group)) {
97-
coords$group <- match(coords$group, unique(coords$group))
97+
coords$group <- match(coords$group, unique0(coords$group))
9898
}
99-
startPoint <- match(unique(coords$group), coords$group)
99+
startPoint <- match(unique0(coords$group), coords$group)
100100
xsplineGrob(coords$x, coords$y,
101101
id = coords$group, default.units = 'native',
102102
shape = 1, open = FALSE,

‎R/diagonal.R

+3-3
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ StatDiagonal <- ggproto('StatDiagonal', Stat,
102102
end <- data
103103
end$x <- end$xend
104104
end$y <- end$yend
105-
data <- rbind(data, end)
105+
data <- vec_rbind(data, end)
106106
data$xend <- NULL
107107
data$yend <- NULL
108108
data <- data[order(data$group), ]
@@ -188,7 +188,7 @@ StatDiagonal0 <- ggproto('StatDiagonal0', Stat,
188188
end <- data
189189
end$x <- end$xend
190190
end$y <- end$yend
191-
data <- rbind(data, end)
191+
data <- vec_rbind(data, end)
192192
data$xend <- NULL
193193
data$yend <- NULL
194194
data <- data[order(data$group), ]
@@ -235,5 +235,5 @@ add_controls <- function(data, strength) {
235235
mid1$x <- mid1$x + x_diff
236236
mid2 <- end
237237
mid2$x <- mid2$x - x_diff
238-
rbind(start, mid1, mid2, end)
238+
vec_rbind(start, mid1, mid2, end)
239239
}

‎R/diagonal_wide.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ StatDiagonalWide <- ggproto('StatDiagonalWide', Stat,
6969
upper <- add_controls(upper[rev(seq_len(nrow(upper))), ], strength)
7070
lower <- StatBezier$compute_panel(lower, scales, n)
7171
upper <- StatBezier$compute_panel(upper, scales, n)
72-
diagonals <- rbind(lower, upper)
72+
diagonals <- vec_rbind(lower, upper)
7373
diagonals$index <- NULL
7474
diagonals[order(diagonals$group), ]
7575
},

‎R/errorbar.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ StatErr <- ggproto(
77
Stat,
88
required_aes = c('xmin', 'x', 'xmax', 'ymin', 'y', 'ymax'),
99
compute_group = function(data, scales) {
10-
data.frame(
10+
data_frame0(
1111
x = c(data$xmin, data$x),
1212
xend = c(data$xmax, data$x),
1313
y = c(data$y, data$ymin),

‎R/facet_grid_paginate.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -74,10 +74,10 @@ FacetGridPaginate <- ggproto('FacetGridPaginate', FacetGrid,
7474
layout$ROW <- layout$ROW - min(layout$ROW) + 1
7575
layout$COL <- layout$COL - min(layout$COL) + 1
7676
layout$PANEL <- 1:dim(layout)[1]
77-
x_scale_ind <- unique(layout$SCALE_X)
77+
x_scale_ind <- unique0(layout$SCALE_X)
7878
x_scales <- x_scales[x_scale_ind]
7979
layout$SCALE_X <- match(layout$SCALE_X, x_scale_ind)
80-
y_scale_ind <- unique(layout$SCALE_Y)
80+
y_scale_ind <- unique0(layout$SCALE_Y)
8181
y_scales <- y_scales[y_scale_ind]
8282
layout$SCALE_Y <- match(layout$SCALE_Y, y_scale_ind)
8383
table <- FacetGrid$draw_panels(panels, layout, x_scales, y_scales, ranges,

‎R/facet_matrix.R

+6-5
Original file line numberDiff line numberDiff line change
@@ -132,11 +132,11 @@ FacetMatrix <- ggproto('FacetMatrix', FacetGrid,
132132
rows <- lapply(data, function(d) {
133133
names(eval_select(quo(c(!!!params$row_vars)), d))
134134
})
135-
rows <- unique(unlist(rows))
135+
rows <- unique0(unlist(rows))
136136
cols <- lapply(data, function(d) {
137137
names(eval_select(quo(c(!!!params$col_vars)), d))
138138
})
139-
cols <- unique(unlist(cols))
139+
cols <- unique0(unlist(cols))
140140
if (length(rows) == 0 || length(cols) == 0) {
141141
cli::cli_abort('{.arg rows} and {.arg cols} must select valid data columns')
142142
}
@@ -185,7 +185,7 @@ FacetMatrix <- ggproto('FacetMatrix', FacetGrid,
185185
map_data = function(data, layout, params) {
186186
layer_pos <- params$layer_pos[[data$.layer_index[1]]]
187187
layer_type <- params$layer_type[[data$.layer_index[1]]]
188-
rbind_dfs(lapply(seq_len(nrow(layout)), function(i) {
188+
data <- lapply(seq_len(nrow(layout)), function(i) {
189189
row <- layout$row_data[i]
190190
col <- layout$col_data[i]
191191
col_discrete <- params$col_scales[[layout$SCALE_X[i]]]$is_discrete()
@@ -202,7 +202,8 @@ FacetMatrix <- ggproto('FacetMatrix', FacetGrid,
202202
data$.panel_x <- params$col_scales[[col]]$map(data[[col]])
203203
data$.panel_y <- params$row_scales[[row]]$map(data[[row]])
204204
data
205-
}))
205+
})
206+
vec_rbind(!!!data)
206207
},
207208
init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) {
208209
scales <- list()
@@ -275,7 +276,7 @@ assign_layers <- function(n_layers, ...) {
275276
}
276277
})
277278

278-
specified_layers <- sort(unique(unlist(specs)))
279+
specified_layers <- sort(unique0(unlist(specs)))
279280
specified_layers <- layers %in% specified_layers
280281

281282
specs <- lapply(specs, function(spec) {

0 commit comments

Comments
 (0)