Skip to content

Commit 24f95ae

Browse files
teunbrandteunbrand
committed
swap facet data mapping from method to standalone function
1 parent 549eba9 commit 24f95ae

File tree

3 files changed

+97
-89
lines changed

3 files changed

+97
-89
lines changed

‎R/facet-.R‎

Lines changed: 93 additions & 89 deletions
Original file line numberDiff line numberDiff line change
@@ -88,95 +88,7 @@ Facet <- ggproto("Facet", NULL,
8888
cli::cli_abort("Not implemented.")
8989
},
9090
map_data = function(data, layout, params) {
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-
grid_layout <- all(c("rows", "cols") %in% names(params))
104-
layer_layout <- attr(data, "layout")
105-
if (identical(layer_layout, "fixed")) {
106-
n <- vec_size(data)
107-
data <- vec_rep(data, vec_size(layout))
108-
data$PANEL <- vec_rep_each(layout$PANEL, n)
109-
return(data)
110-
}
111-
112-
# Compute faceting values
113-
facet_vals <- eval_facets(vars, data, params$.possible_columns)
114-
115-
include_margins <- !isFALSE(params$margin %||% FALSE) &&
116-
nrow(facet_vals) == nrow(data) && grid_layout
117-
if (include_margins) {
118-
# Margins are computed on evaluated faceting values (#1864).
119-
facet_vals <- reshape_add_margins(
120-
vec_cbind(facet_vals, .index = seq_len(nrow(facet_vals))),
121-
list(intersect(names(params$rows), names(facet_vals)),
122-
intersect(names(params$cols), names(facet_vals))),
123-
params$margins %||% FALSE
124-
)
125-
# Apply recycling on original data to fit margins
126-
# We're using base subsetting here because `data` might have a superclass
127-
# that isn't handled well by vctrs::vec_slice
128-
data <- data[facet_vals$.index, , drop = FALSE]
129-
facet_vals$.index <- NULL
130-
}
131-
132-
# If we need to fix rows or columns, we make the corresponding faceting
133-
# variables missing on purpose
134-
if (grid_layout) {
135-
if (identical(layer_layout, "fixed_rows")) {
136-
facet_vals <- facet_vals[setdiff(names(facet_vals), names(params$cols))]
137-
}
138-
if (identical(layer_layout, "fixed_cols")) {
139-
facet_vals <- facet_vals[setdiff(names(facet_vals), names(params$rows))]
140-
}
141-
}
142-
143-
# If any faceting variables are missing, add them in by
144-
# duplicating the data
145-
missing_facets <- setdiff(names(vars), names(facet_vals))
146-
if (length(missing_facets) > 0) {
147-
148-
to_add <- unique0(layout[missing_facets])
149-
150-
data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add))
151-
facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
152-
153-
data <- unrowname(data[data_rep, , drop = FALSE])
154-
facet_vals <- unrowname(vec_cbind(
155-
unrowname(facet_vals[data_rep, , drop = FALSE]),
156-
unrowname(to_add[facet_rep, , drop = FALSE])
157-
))
158-
}
159-
160-
if (nrow(facet_vals) < 1) {
161-
# Add PANEL variable
162-
data$PANEL <- NO_PANEL
163-
return(data)
164-
}
165-
166-
facet_vals[] <- lapply(facet_vals, as_unordered_factor)
167-
facet_vals[] <- lapply(facet_vals, addNA, ifany = TRUE)
168-
layout[] <- lapply(layout, as_unordered_factor)
169-
170-
# Add PANEL variable
171-
keys <- join_keys(facet_vals, layout, by = names(vars))
172-
data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
173-
174-
# Filter panels when layer_layout is an integer
175-
if (is_integerish(layer_layout)) {
176-
data <- vec_slice(data, data$PANEL %in% layer_layout)
177-
}
178-
179-
data
91+
cli::cli_abort("Not implemented.")
18092
},
18193
init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) {
18294
scales <- list()
@@ -960,3 +872,95 @@ censor_labels <- function(ranges, layout, labels) {
960872
}
961873
ranges
962874
}
875+
876+
map_facet_data <- function(data, layout, params) {
877+
878+
if (empty(data)) {
879+
return(vec_cbind(data %|W|% NULL, PANEL = integer(0)))
880+
}
881+
882+
vars <- params$facet %||% c(params$rows, params$cols)
883+
884+
if (length(vars) == 0) {
885+
data$PANEL <- layout$PANEL
886+
return(data)
887+
}
888+
889+
grid_layout <- all(c("rows", "cols") %in% names(params))
890+
layer_layout <- attr(data, "layout")
891+
if (identical(layer_layout, "fixed")) {
892+
n <- vec_size(data)
893+
data <- vec_rep(data, vec_size(layout))
894+
data$PANEL <- vec_rep_each(layout$PANEL, n)
895+
return(data)
896+
}
897+
898+
# Compute faceting values
899+
facet_vals <- eval_facets(vars, data, params$.possible_columns)
900+
901+
include_margins <- !isFALSE(params$margin %||% FALSE) &&
902+
nrow(facet_vals) == nrow(data) && grid_layout
903+
if (include_margins) {
904+
# Margins are computed on evaluated faceting values (#1864).
905+
facet_vals <- reshape_add_margins(
906+
vec_cbind(facet_vals, .index = seq_len(nrow(facet_vals))),
907+
list(intersect(names(params$rows), names(facet_vals)),
908+
intersect(names(params$cols), names(facet_vals))),
909+
params$margins %||% FALSE
910+
)
911+
# Apply recycling on original data to fit margins
912+
# We're using base subsetting here because `data` might have a superclass
913+
# that isn't handled well by vctrs::vec_slice
914+
data <- data[facet_vals$.index, , drop = FALSE]
915+
facet_vals$.index <- NULL
916+
}
917+
918+
# If we need to fix rows or columns, we make the corresponding faceting
919+
# variables missing on purpose
920+
if (grid_layout) {
921+
if (identical(layer_layout, "fixed_rows")) {
922+
facet_vals <- facet_vals[setdiff(names(facet_vals), names(params$cols))]
923+
}
924+
if (identical(layer_layout, "fixed_cols")) {
925+
facet_vals <- facet_vals[setdiff(names(facet_vals), names(params$rows))]
926+
}
927+
}
928+
929+
# If any faceting variables are missing, add them in by
930+
# duplicating the data
931+
missing_facets <- setdiff(names(vars), names(facet_vals))
932+
if (length(missing_facets) > 0) {
933+
934+
to_add <- unique0(layout[missing_facets])
935+
936+
data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add))
937+
facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data))
938+
939+
data <- unrowname(data[data_rep, , drop = FALSE])
940+
facet_vals <- unrowname(vec_cbind(
941+
unrowname(facet_vals[data_rep, , drop = FALSE]),
942+
unrowname(to_add[facet_rep, , drop = FALSE])
943+
))
944+
}
945+
946+
if (nrow(facet_vals) < 1) {
947+
# Add PANEL variable
948+
data$PANEL <- NO_PANEL
949+
return(data)
950+
}
951+
952+
facet_vals[] <- lapply(facet_vals, as_unordered_factor)
953+
facet_vals[] <- lapply(facet_vals, addNA, ifany = TRUE)
954+
layout[] <- lapply(layout, as_unordered_factor)
955+
956+
# Add PANEL variable
957+
keys <- join_keys(facet_vals, layout, by = names(vars))
958+
data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
959+
960+
# Filter panels when layer_layout is an integer
961+
if (is_integerish(layer_layout)) {
962+
data <- vec_slice(data, data$PANEL %in% layer_layout)
963+
}
964+
965+
data
966+
}

‎R/facet-grid-.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -294,6 +294,8 @@ FacetGrid <- ggproto("FacetGrid", Facet,
294294
panels
295295
},
296296

297+
map_data = map_facet_data,
298+
297299
attach_axes = function(table, layout, ranges, coord, theme, params) {
298300

299301
# Setup parameters

‎R/facet-wrap.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -257,6 +257,8 @@ FacetWrap <- ggproto("FacetWrap", Facet,
257257
panels
258258
},
259259

260+
map_data = map_facet_data,
261+
260262
attach_axes = function(table, layout, ranges, coord, theme, params) {
261263

262264
# Setup parameters

0 commit comments

Comments
 (0)