Estoy tratando de crear una facet_multi_col()función, similar a la facet_col()función en ggforce, que permite un diseño de facetas con un argumento de espacio (que no está disponible en facet_wrap()), pero en varias columnas. Como en el último gráfico a continuación (creado con grid.arrange()), no quiero que las facetas se alineen necesariamente entre las filas, ya que las alturas en cada faceta variarán en función de una yvariable categórica que deseo utilizar.
Me encuentro fuera de mi alcance ggprotoal leer la guía de extensión . Creo que el mejor enfoque es pasar una matriz de diseño para dictar dónde dividir las columnas para los subconjuntos correspondientes de los datos, y construir facet_col en ggforce para incluir un parámetro de espacio; vea el final de la pregunta.
Una ilustración rápida de mis opciones insatisfactorias
Sin faceta
library(tidyverse)
library(gapminder)
global_tile <- ggplot(data = gapminder, mapping = aes(x = year, y = fct_rev(country), fill = lifeExp)) +
geom_tile()
global_tile
Quiero desglosar la trama por continentes. No quiero una figura tan larga.
facet_wrap ()
global_tile +
facet_wrap(facets = "continent", scales = "free")
facet_wrap()no tiene un argumento de espacio, lo que significa que los mosaicos son de diferentes tamaños en cada continente, usando coord_equal()arroja un error
facet_col () en ggforce
library(ggforce)
global_tile +
facet_col(facets = "continent", scales = "free", space = "free", strip.position = "right") +
theme(strip.text.y = element_text(angle = 0)) 
Como las tiras a los lados. spaceEl argumento establece que todos los mosaicos tengan el mismo tamaño. Todavía es demasiado largo para caber en una página.
grid.arrange () en gridExtra
Agregue una columna columna a los datos para ubicar cada continente
d <- gapminder %>%
as_tibble() %>%
mutate(col = as.numeric(continent),
col = ifelse(test = continent == "Europe", yes = 2, no = col),
col = ifelse(test = continent == "Oceania", yes = 3, no = col))
head(d)
# # A tibble: 6 x 7
# country continent year lifeExp pop gdpPercap col
# <fct> <fct> <int> <dbl> <int> <dbl> <dbl>
# 1 Afghanistan Asia 1952 28.8 8425333 779. 3
# 2 Afghanistan Asia 1957 30.3 9240934 821. 3
# 3 Afghanistan Asia 1962 32.0 10267083 853. 3
# 4 Afghanistan Asia 1967 34.0 11537966 836. 3
# 5 Afghanistan Asia 1972 36.1 13079460 740. 3
# 6 Afghanistan Asia 1977 38.4 14880372 786. 3
tail(d)
# # A tibble: 6 x 7
# country continent year lifeExp pop gdpPercap col
# <fct> <fct> <int> <dbl> <int> <dbl> <dbl>
# 1 Zimbabwe Africa 1982 60.4 7636524 789. 1
# 2 Zimbabwe Africa 1987 62.4 9216418 706. 1
# 3 Zimbabwe Africa 1992 60.4 10704340 693. 1
# 4 Zimbabwe Africa 1997 46.8 11404948 792. 1
# 5 Zimbabwe Africa 2002 40.0 11926563 672. 1
# 6 Zimbabwe Africa 2007 43.5 12311143 470. 1Use facet_col()para trazar para cada columna
g <- list()
for(i in unique(d$col)){
g[[i]] <- d %>%
filter(col == i) %>%
ggplot(mapping = aes(x = year, y = fct_rev(country), fill = lifeExp)) +
geom_tile() +
facet_col(facets = "continent", scales = "free_y", space = "free", strip.position = "right") +
theme(strip.text.y = element_text(angle = 0)) +
# aviod legends in every column
guides(fill = FALSE) +
labs(x = "", y = "")
}Crea una leyenda usando get_legend()encowplot
library(cowplot)
gg <- ggplot(data = d, mapping = aes(x = year, y = country, fill = lifeExp)) +
geom_tile()
leg <- get_legend(gg)Cree una matriz de diseño con alturas basadas en el número de países en cada columna.
m <-
d %>%
group_by(col) %>%
summarise(row = n_distinct(country)) %>%
rowwise() %>%
mutate(row = paste(1:row, collapse = ",")) %>%
separate_rows(row) %>%
mutate(row = as.numeric(row),
col = col,
p = col) %>%
xtabs(formula = p ~ row + col) %>%
cbind(max(d$col) + 1) %>%
ifelse(. == 0, NA, .)
head(m)
# 1 2 3
# 1 1 2 3 4
# 2 1 2 3 4
# 3 1 2 3 4
# 4 1 2 3 4
# 5 1 2 3 4
# 6 1 2 3 4
tail(m)
# 1 2 3
# 50 1 2 NA 4
# 51 1 2 NA 4
# 52 1 2 NA 4
# 53 NA 2 NA 4
# 54 NA 2 NA 4
# 55 NA 2 NA 4Reunir gy legusar juntos grid.arrange()engridExtra
library(gridExtra)
grid.arrange(g[[1]], g[[2]], g[[3]], leg, layout_matrix = m, widths=c(0.32, 0.32, 0.32, 0.06))
Esto es casi lo que busco, pero no estoy satisfecho porque a) los mosaicos en diferentes columnas tienen diferentes anchos, ya que la longitud de los nombres de países y continentes más largos no es igual yb) es una gran cantidad de código que debe ajustarse cada uno cada vez que quiero hacer un diagrama como este, con otros datos, quiero organizar las facetas por regiones, por ejemplo, "Europa occidental" en lugar de continentes o el número de cambios de países, no hay países de Asia Central en los gapminderdatos.
Progreso en la creación de una función facet_multi_cols ()
Quiero pasar una matriz de diseño a una función de faceta, donde la matriz se referiría a cada faceta, y la función podría calcular las alturas en función del número de espacios en cada panel. Para el ejemplo anterior, la matriz sería:
my_layout <- matrix(c(1, NA, 2, 3, 4, 5), nrow = 2)
my_layout
# [,1] [,2] [,3]
# [1,] 1 2 4
# [2,] NA 3 5Como se mencionó anteriormente, me he estado adaptando del código facet_col()para tratar de construir una facet_multi_col()función. He agregado un layoutargumento para proporcionar una matriz como la my_layoutanterior, con la idea de que, por ejemplo, el cuarto y quinto nivel de la variable dada al facetsargumento se traza en la tercera columna.
facet_multi_col <- function(facets, layout, scales = "fixed", space = "fixed",
shrink = TRUE, labeller = "label_value",
drop = TRUE, strip.position = 'top') {
# add space argument as in facet_col
space <- match.arg(space, c('free', 'fixed'))
facet <- facet_wrap(facets, col = col, dir = dir, scales = scales, shrink = shrink, labeller = labeller, drop = drop, strip.position = strip.position)
params <- facet$params
params <- facet$layout
params$space_free <- space == 'free'
ggproto(NULL, FacetMultiCols, shrink = shrink, params = params)
}
FacetMultiCols <- ggproto('FacetMultiCols', FacetWrap,
# from FacetCols to allow for space argument to work
draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
combined <- ggproto_parent(FacetWrap, self)$draw_panels(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params)
if (params$space_free) {
widths <- vapply(layout$PANEL, function(i) diff(ranges[[i]]$x.range), numeric(1))
panel_widths <- unit(widths, "null")
combined$widths[panel_cols(combined)$l] <- panel_widths
}
combined
}
# adapt FacetWrap layout to set position on panels following the matrix given to layout in facet_multi_col().
compute_layout = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
layout <- ggproto_parent(FacetWrap, self)$compute_layout(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params)
# ???
)Creo que necesito escribir algo para la compute_layoutparte, pero estoy luchando por descubrir cómo hacerlo.
grid.arrangeejemplo anterior ... ¿a menos que quieras decir algo diferente? ¿Creo que existirían los mismos problemas con diferentes longitudes de etiqueta en cada columna?
grid.arrange. Es una publicación muy larga, por lo que es difícil seguir todo lo que has probado. Un poco hacky, pero puede probar un monoespacio / fuente más cercana a una fuente uniformemente espaciada para las etiquetas para que sus longitudes sean más predecibles. Incluso podría rellenar las etiquetas con espacios en blanco para asegurarse de que el texto esté más cerca de la misma longitud.
