@@ -872,3 +872,95 @@ censor_labels <- function(ranges, layout, labels) {
872872 }
873873 ranges
874874}
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+ }
0 commit comments