Estou tentando criar uma facet_multi_col()função, semelhante à facet_col()função em ggforce- que permite um layout de faceta com um argumento de espaço (que não está disponível em facet_wrap()) -, mas em várias colunas. Como no último gráfico abaixo (criado com grid.arrange()), não quero que as facetas se alinhem necessariamente entre as linhas, pois as alturas de cada faceta variam com base em uma yvariável categórica que desejo usar.
Estou me sentindo bem fora de questão por ggprototer lido o guia de extensão . Eu acho que a melhor abordagem é passar uma matriz de layout para determinar onde quebrar colunas para os subconjuntos correspondentes dos dados e criar facet_col no ggforce para incluir um parâmetro de espaço - veja o final da pergunta.
Uma rápida ilustração das minhas opções insatisfatórias
Nenhuma faceta
library(tidyverse)
library(gapminder)
global_tile <- ggplot(data = gapminder, mapping = aes(x = year, y = fct_rev(country), fill = lifeExp)) +
geom_tile()
global_tile
Eu quero dividir o enredo por continentes. Eu não quero uma figura tão longa.
facet_wrap ()
global_tile +
facet_wrap(facets = "continent", scales = "free")
facet_wrap()não possui um argumento de espaço, o que significa que os blocos têm tamanhos diferentes em cada continente, usando coord_equal()gera um erro
facet_col () no 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 as tiras do lado. spaceO argumento define todos os blocos para o mesmo tamanho. Ainda é muito longo para caber em uma página.
grid.arrange () em gridExtra
Adicione uma coluna aos dados para onde cada continente deve ser colocado
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 plotagem para cada coluna
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 = "")
}Criar uma lenda usando get_legend()emcowplot
library(cowplot)
gg <- ggplot(data = d, mapping = aes(x = year, y = country, fill = lifeExp)) +
geom_tile()
leg <- get_legend(gg)Crie uma matriz de layout com alturas com base no número de países em cada coluna.
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 4Traga ge legem conjunto, utilizando grid.arrange()emgridExtra
library(gridExtra)
grid.arrange(g[[1]], g[[2]], g[[3]], leg, layout_matrix = m, widths=c(0.32, 0.32, 0.32, 0.06))
Isso é quase o que eu busco, mas não estou satisfeito porque: a) os blocos em colunas diferentes têm larguras diferentes, pois o comprimento dos nomes mais longos de países e continentes não são iguais eb) é muito código que precisa ser ajustado cada Quando quero fazer um enredo como este - com outros dados, quero organizar as facetas por regiões, por exemplo, "Europa Ocidental" em vez de continentes ou o número de países mudar - não há países da Ásia Central nos gapminderdados.
Progresso na criação de uma função facet_multi_cols ()
Quero passar uma matriz de layout para uma função de faceta, onde a matriz se referiria a cada faceta, e a função poderia descobrir as alturas com base no número de espaços em cada painel. Para o exemplo acima, a matriz seria:
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 mencionado acima, eu tenho me adaptado do código facet_col()para tentar criar uma facet_multi_col()função. Eu adicionei um layoutargumento para fornecer matriz como my_layoutacima, com a ideia de que, por exemplo, o quarto e o quinto nível da variável dada ao facetsargumento sejam plotados na terceira coluna.
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)
# ???
)Acho que preciso escrever algo para a compute_layoutparte, mas estou lutando para descobrir como fazer isso.
grid.arrangeexemplo acima .. a menos que você queira dizer algo diferente? Eu acho que os mesmos problemas existiriam com diferentes comprimentos de etiqueta em cada coluna?
grid.arrange. É um post muito longo, por isso é difícil seguir tudo o que você tentou. Um pouco hacky, mas você pode tentar uma fonte monoespaçada / mais próxima de uma fonte uniformemente espaçada para os rótulos, para que seus comprimentos sejam mais previsíveis. Você pode colocar etiquetas em espaços em branco para garantir que o texto esteja mais próximo do mesmo comprimento.
