Skip to content

Commit c0ba01c

Browse files
teunbrandteunbrand
committed
unify Facet$map_data() approaches
1 parent 28ba951 commit c0ba01c

File tree

3 files changed

+63
-116
lines changed

3 files changed

+63
-116
lines changed

‎R/facet-.R

Lines changed: 63 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -88,7 +88,69 @@ Facet <- ggproto("Facet", NULL,
8888
cli::cli_abort("Not implemented.")
8989
},
9090
map_data = function(data, layout, params) {
91-
cli::cli_abort("Not implemented.")
91+
92+
if (empty(data)) {
93+
return(vec_cbind(data %|W|% NULL, PANEL = integer(0)))
94+
}
95+
96+
vars <- params$facet %||% c(params$rows, params$cols)
97+
98+
if (length(vars) == 0) {
99+
data$PANEL <- layout$PANEL
100+
return(data)
101+
}
102+
103+
layer_layout <- attr(data, "layout")
104+
if (identical(layer_layout, "fixed")) {
105+
n <- vec_size(data)
106+
data <- vec_rep(data, vec_size(layout))
107+
data$PANEL <- vec_rep_each(layout$PANEL, n)
108+
return(data)
109+
}
110+
111+
facet_vals <- eval_facets(vars, data, params$.possible_columns)
112+
113+
include_margins <- !isFALSE(params$margin %||% FALSE) &&
114+
nrow(facet_vals) == nrow(data) &&
115+
all(c("rows", "cols") %in% names(params))
116+
if (include_margins) {
117+
facet_vals <- reshape_add_margins(
118+
vec_cbind(facet_vals, .index = seq_len(nrow(facet_vals))),
119+
list(intersect(names(params$rows), names(facet_vals)),
120+
intersect(names(params$cols), names(facet_vals))),
121+
params$margins %||% FALSE
122+
)
123+
data <- data[facet_vals$.index, , drop = FALSE]
124+
facet_vals$.index <- NULL
125+
}
126+
127+
missing_facets <- setdiff(names(vars), names(facet_vals))
128+
if (length(missing_facets) > 0) {
129+
130+
to_add <- unique0(layout[missing_facets])
131+
132+
data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add))
133+
facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
134+
135+
data <- unrowname(data[data_rep, , drop = FALSE])
136+
facet_vals <- unrowname(vec_cbind(
137+
unrowname(facet_vals[data_rep, , drop = FALSE]),
138+
unrowname(to_add[facet_rep, , drop = FALSE])
139+
))
140+
}
141+
142+
if (nrow(facet_vals) < 1) {
143+
data$PANEL <- NO_PANEL
144+
return(data)
145+
}
146+
147+
facet_vals[] <- lapply(facet_vals, as_unordered_factor)
148+
facet_vals[] <- lapply(facet_vals, addNA, ifany = TRUE)
149+
layout[] <- lapply(layout, as_unordered_factor)
150+
151+
keys <- join_keys(facet_vals, layout, by = names(vars))
152+
data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
153+
data
92154
},
93155
init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) {
94156
scales <- list()

‎R/facet-grid-.R

Lines changed: 0 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -283,77 +283,6 @@ FacetGrid <- ggproto("FacetGrid", Facet,
283283

284284
panels
285285
},
286-
map_data = function(data, layout, params) {
287-
if (empty(data)) {
288-
return(vec_cbind(data %|W|% NULL, PANEL = integer(0)))
289-
}
290-
291-
rows <- params$rows
292-
cols <- params$cols
293-
vars <- c(names(rows), names(cols))
294-
295-
if (length(vars) == 0) {
296-
data$PANEL <- layout$PANEL
297-
return(data)
298-
}
299-
300-
layer_layout <- attr(data, "layout")
301-
if (identical(layer_layout, "fixed")) {
302-
n <- vec_size(data)
303-
data <- vec_rep(data, nrow(layout))
304-
data$PANEL <- vec_rep_each(layout$PANEL, n)
305-
return(data)
306-
}
307-
308-
# Compute faceting values
309-
facet_vals <- eval_facets(c(rows, cols), data, params$.possible_columns)
310-
if (nrow(facet_vals) == nrow(data)) {
311-
# Margins are computed on evaluated faceting values (#1864).
312-
facet_vals <- reshape_add_margins(
313-
# We add an index column to track data recycling
314-
vec_cbind(facet_vals, .index = seq_len(nrow(facet_vals))),
315-
list(intersect(names(rows), names(facet_vals)),
316-
intersect(names(cols), names(facet_vals))),
317-
params$margins
318-
)
319-
# Apply recycling on original data to fit margins
320-
# We're using base subsetting here because `data` might have a superclass
321-
# that isn't handled well by vctrs::vec_slice
322-
data <- data[facet_vals$.index, , drop = FALSE]
323-
facet_vals$.index <- NULL
324-
}
325-
326-
# If any faceting variables are missing, add them in by
327-
# duplicating the data
328-
missing_facets <- setdiff(vars, names(facet_vals))
329-
if (length(missing_facets) > 0) {
330-
to_add <- unique0(layout[missing_facets])
331-
332-
data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add))
333-
facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
334-
335-
data <- unrowname(data[data_rep, , drop = FALSE])
336-
facet_vals <- unrowname(vec_cbind(
337-
unrowname(facet_vals[data_rep, , drop = FALSE]),
338-
unrowname(to_add[facet_rep, , drop = FALSE]))
339-
)
340-
}
341-
342-
# Add PANEL variable
343-
if (nrow(facet_vals) == 0) {
344-
# Special case of no faceting
345-
data$PANEL <- NO_PANEL
346-
} else {
347-
facet_vals[] <- lapply(facet_vals[], as_unordered_factor)
348-
facet_vals[] <- lapply(facet_vals[], addNA, ifany = TRUE)
349-
layout[] <- lapply(layout[], as_unordered_factor)
350-
351-
keys <- join_keys(facet_vals, layout, by = vars)
352-
353-
data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
354-
}
355-
data
356-
},
357286

358287
attach_axes = function(table, layout, ranges, coord, theme, params) {
359288

‎R/facet-wrap.R

Lines changed: 0 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -246,50 +246,6 @@ FacetWrap <- ggproto("FacetWrap", Facet,
246246

247247
panels
248248
},
249-
map_data = function(data, layout, params) {
250-
if (empty(data)) {
251-
return(vec_cbind(data %|W|% NULL, PANEL = integer(0)))
252-
}
253-
254-
vars <- params$facets
255-
256-
if (length(vars) == 0) {
257-
data$PANEL <- layout$PANEL
258-
return(data)
259-
}
260-
261-
layer_layout <- attr(data, "layout")
262-
if (identical(layer_layout, "fixed")) {
263-
n <- vec_size(data)
264-
data <- vec_rep(data, nrow(layout))
265-
data$PANEL <- vec_rep_each(layout$PANEL, n)
266-
return(data)
267-
}
268-
269-
facet_vals <- eval_facets(vars, data, params$.possible_columns)
270-
facet_vals[] <- lapply(facet_vals[], as_unordered_factor)
271-
layout[] <- lapply(layout[], as_unordered_factor)
272-
273-
missing_facets <- setdiff(names(vars), names(facet_vals))
274-
if (length(missing_facets) > 0) {
275-
276-
to_add <- unique0(layout[missing_facets])
277-
278-
data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add))
279-
facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
280-
281-
data <- data[data_rep, , drop = FALSE]
282-
facet_vals <- vec_cbind(
283-
facet_vals[data_rep, , drop = FALSE],
284-
to_add[facet_rep, , drop = FALSE]
285-
)
286-
}
287-
288-
keys <- join_keys(facet_vals, layout, by = names(vars))
289-
290-
data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
291-
data
292-
},
293249

294250
attach_axes = function(table, layout, ranges, coord, theme, params) {
295251

0 commit comments

Comments
 (0)