Построить несколько матриц в гранях с различной осью XY

Question

Я собрал данные с ряда онлайн-форумов и хотел построить с использованием ggplot и facets (по одному фасету на форум) матрицу, представляющую, сколько раз пользователь A ответил пользователю B.

Вот код для загрузки игрушечного примера:

library(ggplot2)
library(dplyr)

df.edges <- data.frame(from = c('forum1_user1', 'forum1_user1',
                                'forum1_user2', 'forum1_user2',
                                'forum2_user1', 'forum2_user1',
                                'forum2_user2', 'forum2_user2',
                                'forum3_user1', 'forum3_user1',
                                'forum3_user2', 'forum3_user2'),
                         to = c('forum1_user1', 'forum1_user2',
                                'forum1_user1', 'forum1_user2',
                                'forum2_user1', 'forum2_user2',
                                'forum2_user1', 'forum2_user2',
                                'forum3_user1', 'forum3_user2',
                                'forum3_user1', 'forum3_user2'),
                        weight = 1:12,
                        timestamp = 1:12,
                        subforum = c('forum1', 'forum1', 'forum1', 'forum1',
                                     'forum2', 'forum2', 'forum2', 'forum2',
                                     'forum3', 'forum3', 'forum3', 'forum3'))

Я пытаюсь это:

# Sort for later use in scale_discrete
df.edges <- df.edges %>% arrange(timestamp)


gg <- ggplot(df.edges, aes(x = from, y = to, fill = weight)) +
  geom_raster() + coord_fixed() + 
  facet_grid(. ~subforum, scales='fixed') +
  scale_x_discrete("from", aes(limits = from))+
  scale_y_discrete("to", aes(limits = from)) + 
  theme_bw() +
  theme(axis.line        = element_blank(),
        axis.text.x      = element_text(angle = 90, hjust=1, size=8),
        axis.text.y      = element_text(hjust=1, size=10),
        axis.ticks       = element_blank(),
        strip.background = element_rect(fill = 'white'), 
        aspect.ratio = 1) +
  ggtitle("Matrix of interactions") + xlab('from') + ylab('to')
print(gg)

что дает это:

И если я установлю масштаб фасетов scale='free':

Однако я хочу, чтобы каждый аспект отображал только тех пользователей, которые принадлежат этому форуму. Матрицы должны быть полностью заполнены 4 ячейками в каждой.

Любая идея?

Answer 1

Вы можете создать отдельный сюжет для каждого уровня subforum а затем выложить их вместе, используя grid.arrange:

library(gridExtra)
library(grid)

Сначала создайте отдельные участки и сохраните их в списке. Мы добавляем scale_fill_continuous(limits=range(df.edges$weight)) чтобы обеспечить равномерный градиент заполнения на трех графиках:

pl = lapply(split(df.edges, df.edges$subforum), function(df) {
    ggplot(df, aes(x = from, y = to, fill = weight)) +
      geom_raster() + coord_fixed() + 
      facet_grid(. ~subforum, scales='fixed') +
      scale_x_discrete("from", aes(limits = from))+
      scale_y_discrete("to", aes(limits = from)) + 
      scale_fill_continuous(limits=range(df.edges$weight)) +
      theme_bw() +
      theme(axis.line        = element_blank(),
            axis.text.x      = element_text(angle = 90, hjust=1, size=8),
            axis.text.y      = element_text(hjust=1, size=10),
            axis.ticks       = element_blank(),
            strip.background = element_rect(fill = 'white'), 
            aspect.ratio = 1) +
      xlab('from') + ylab('to') 
  })

Извлеките легенду, так как нам нужна только одна легенда, а не отдельная легенда для каждого сюжета:

# Function to extract legend
#https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs
g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend) }

# Extract legend as a grob
leg = g_legend(pl[[1]])

Расставьте сюжеты с легендой и названием:

grid.arrange(
  textGrob("Matrix of Interactions"),
  arrangeGrob(
    arrangeGrob(grobs=lapply(pl, function(x) x + guides(fill=FALSE)), ncol=3), 
    leg, ncol=2, widths=c(10,1)
  ),
  heights=c(1,20)
)