J'essaie de créer une facet_multi_col()fonction, similaire à la facet_col()fonction dans ggforce- qui permet une mise en page à facettes avec un argument espace (qui n'est pas disponible dans facet_wrap()) - mais sur plusieurs colonnes. Comme dans le dernier tracé ci-dessous (créé avec grid.arrange()), je ne veux pas que les facettes s'alignent nécessairement sur les lignes car les hauteurs de chaque facette varieront en fonction d'une yvariable catégorielle que je souhaite utiliser.
Je me retrouve bien en dehors de ma profondeur ggprotoaprès avoir lu le guide d' extension . Je pense que la meilleure approche est de passer une matrice de disposition pour dicter où casser les colonnes pour les sous-ensembles correspondants des données, et de construire facet_col dans ggforce pour inclure un paramètre d'espace - voir la fin de la question.
Une illustration rapide de mes options insatisfaisantes
Aucune facette
library(tidyverse)
library(gapminder)
global_tile <- ggplot(data = gapminder, mapping = aes(x = year, y = fct_rev(country), fill = lifeExp)) +
geom_tile()
global_tile
Je veux décomposer l'intrigue par continents. Je ne veux pas d'un chiffre aussi long.
facet_wrap ()
global_tile +
facet_wrap(facets = "continent", scales = "free")
facet_wrap()n'a pas d'argument espace, ce qui signifie que les tuiles sont de tailles différentes dans chaque continent, en utilisant coord_equal()jette une erreur
facet_col () dans ggforce
library(ggforce)
global_tile +
facet_col(facets = "continent", scales = "free", space = "free", strip.position = "right") +
theme(strip.text.y = element_text(angle = 0)) 
Comme les bandes sur le côté. spaceL'argument définit toutes les tuiles à la même taille. Encore trop long pour tenir sur une page.
grid.arrange () dans gridExtra
Ajouter une colonne de colonne aux données pour où chaque continent doit être placé
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. 1Utiliser facet_col()pour le tracé pour chaque colonne
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 = "")
}Créez une légende à l'aide get_legend()decowplot
library(cowplot)
gg <- ggplot(data = d, mapping = aes(x = year, y = country, fill = lifeExp)) +
geom_tile()
leg <- get_legend(gg)Créez une matrice de mise en page avec des hauteurs basées sur le nombre de pays dans chaque colonne.
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 4Apportez get legensemble à l' aide grid.arrange()degridExtra
library(gridExtra)
grid.arrange(g[[1]], g[[2]], g[[3]], leg, layout_matrix = m, widths=c(0.32, 0.32, 0.32, 0.06))
C'est presque ce que je recherche, mais je ne suis pas satisfait car a) les tuiles dans différentes colonnes ont des largeurs différentes car la longueur des noms de pays et de continents les plus longs n'est pas égale et b) c'est beaucoup de code qui doit être modifié chacun fois que je veux faire un tracé comme celui-ci - avec d'autres données, je veux organiser les facettes par régions, par exemple "Europe occidentale" plutôt que par continents ou le nombre de pays change - il n'y a pas de pays d'Asie centrale dans les gapminderdonnées.
Progression de la création d'une fonction facet_multi_cols ()
Je veux passer une matrice de disposition à une fonction de facette, où la matrice ferait référence à chaque facette, et la fonction pourrait alors déterminer les hauteurs en fonction du nombre d'espaces dans chaque panneau. Pour l'exemple ci-dessus, la matrice serait:
my_layout <- matrix(c(1, NA, 2, 3, 4, 5), nrow = 2)
my_layout
# [,1] [,2] [,3]
# [1,] 1 2 4
# [2,] NA 3 5Comme mentionné ci-dessus, je me suis adapté du code facet_col()pour essayer de créer une facet_multi_col()fonction. J'ai ajouté un layoutargument pour fournir une matrice comme my_layoutci-dessus, avec l'idée que, par exemple, les quatrième et cinquième niveaux de la variable donnée à l' facetsargument sont tracés dans la troisième colonne.
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)
# ???
)Je pense que j'ai besoin d'écrire quelque chose pour la compute_layoutpartie, mais j'ai du mal à comprendre comment le faire.
grid.arrangeexemple ci-dessus .. sauf si vous voulez dire quelque chose de différent? Je pense que les mêmes problèmes existeraient avec différentes longueurs d'étiquette dans chaque colonne?
grid.arrange. C'est un très long post, il est donc difficile de suivre tout ce que vous avez essayé. Un peu hacky, mais vous pourriez essayer une police monospace / plus proche de l'espacement uniforme pour les étiquettes afin que leurs longueurs soient plus prévisibles. Vous pouvez même ajouter des étiquettes avec des espaces vides pour vous assurer que le texte est plus proche de la même longueur.
