Saya mencoba membuat facet_multi_col()fungsi, mirip dengan facet_col()fungsi di ggforce- yang memungkinkan untuk tata letak segi dengan argumen ruang (yang tidak tersedia di facet_wrap()) - tetapi lebih dari beberapa kolom. Seperti pada plot terakhir di bawah ini (dibuat dengan grid.arrange()) saya tidak ingin sisi-sisi harus sejajar di setiap baris karena ketinggian di setiap sisi akan bervariasi berdasarkan pada yvariabel kategorikal yang ingin saya gunakan.
Saya menemukan diri saya keluar dari kedalaman dengan ggprotomembaca panduan ekstensi . Saya pikir pendekatan terbaik adalah dengan melewatkan matriks tata letak untuk menentukan di mana memecah kolom untuk himpunan bagian data yang sesuai, dan untuk membangun facet_col di ggforce untuk memasukkan parameter ruang - lihat bagian akhir pertanyaan.
Ilustrasi singkat opsi tidak memuaskan saya
Tidak ada segi
library(tidyverse)
library(gapminder)
global_tile <- ggplot(data = gapminder, mapping = aes(x = year, y = fct_rev(country), fill = lifeExp)) +
geom_tile()
global_tile
Saya ingin memecah plot oleh benua. Saya tidak ingin sosok yang panjang.
facet_wrap ()
global_tile +
facet_wrap(facets = "continent", scales = "free")
facet_wrap()tidak memiliki argumen ruang yang berarti ubin berbeda ukuran di setiap benua, menggunakan coord_equal()kesalahan melempar
facet_col () di ggforce
library(ggforce)
global_tile +
facet_col(facets = "continent", scales = "free", space = "free", strip.position = "right") +
theme(strip.text.y = element_text(angle = 0)) 
Seperti strip di samping. spaceargumen mengatur semua ubin ke ukuran yang sama. Masih terlalu panjang untuk masuk ke halaman.
grid.arrange () di gridExtra
Tambahkan kolom kolom ke data di mana setiap benua harus ditempatkan
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. 1Gunakan facet_col()untuk plot untuk setiap kolom
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 = "")
}Buat legenda menggunakan get_legend()dicowplot
library(cowplot)
gg <- ggplot(data = d, mapping = aes(x = year, y = country, fill = lifeExp)) +
geom_tile()
leg <- get_legend(gg)Buat matriks tata letak dengan ketinggian berdasarkan jumlah negara di setiap kolom.
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 4Membawa gdan legbersama-sama menggunakan grid.arrange()digridExtra
library(gridExtra)
grid.arrange(g[[1]], g[[2]], g[[3]], leg, layout_matrix = m, widths=c(0.32, 0.32, 0.32, 0.06))
Ini hampir seperti apa yang saya kejar, tetapi saya tidak puas karena a) ubin di kolom yang berbeda memiliki lebar yang berbeda karena panjang nama negara dan benua terpanjang tidak sama dan b) banyak kode yang perlu diubah setiap kali saya ingin membuat plot seperti ini - dengan data lain saya ingin mengatur segi berdasarkan wilayah, misalnya "Eropa Barat" daripada benua atau jumlah negara yang berubah - tidak ada negara Asia Tengah dalam gapminderdata.
Kemajuan dengan membuat fungsi facet_multi_cols ()
Saya ingin melewatkan matriks tata letak ke fungsi facet, di mana matriks akan merujuk ke setiap facet, dan fungsi itu kemudian bisa mengetahui ketinggian berdasarkan jumlah ruang di setiap panel. Untuk contoh di atas matriksnya adalah:
my_layout <- matrix(c(1, NA, 2, 3, 4, 5), nrow = 2)
my_layout
# [,1] [,2] [,3]
# [1,] 1 2 4
# [2,] NA 3 5Seperti yang disebutkan di atas, saya telah beradaptasi dari kode facet_col()untuk mencoba dan membangun suatu facet_multi_col()fungsi. Saya telah menambahkan layoutargumen untuk memberikan matriks seperti di my_layoutatas, dengan gagasan bahwa, misalnya, tingkat keempat dan kelima dari variabel yang diberikan kepada facetsargumen diplot di kolom ketiga.
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)
# ???
)Saya pikir saya perlu menulis sesuatu untuk compute_layoutbagian ini, tetapi saya berjuang untuk mencari tahu bagaimana melakukan ini.
grid.arrangecontoh di atas .. kecuali Anda bermaksud sesuatu yang berbeda? Saya pikir masalah yang sama akan ada dengan panjang label yang berbeda di setiap kolom?
grid.arrange. Ini adalah posting yang sangat panjang sehingga sulit untuk mengikuti semua yang Anda coba. Sedikit berantakan, tetapi Anda dapat mencoba monospace / lebih dekat ke font spasi seragam untuk label sehingga panjangnya lebih mudah diprediksi. Anda bahkan dapat menempelkan label dengan spasi kosong untuk memastikan teks lebih dekat dengan panjang yang sama.
