Блог

У меня есть набор данных, который выглядит следующим образом:

 test<-data.frame("M"=c("a","b","c","a","b","b","c","a","b","c"), 
                 "N"=c(1,3,4,6,6,7,7,8,8,8), 
                 "X"=c(0,1,0,1,1,0,1,0,1,1), 
                 "Y"=c(1,1,0,0,1,0,1,1,1,0))
  

Я создаю простой график там, где я хочу X , и Y по оси y, M по оси x, каждая сетка окрашена, если значение X или Y равно 1 , и пуста, если значение X или Y равно 0 . Я повторяю это для каждой категории в N (категориями N являются 1 to 5 , 6 , 7 , 8 ), затем складываю все графики вместе. Прямо сейчас я делаю это со следующим кодом.

 test <- test[order(test$N),]
test1 <- test[c(1:3),]
test2 <- test[c(4:5),]
test3 <- test[c(6:7),]
test4 <- test[c(8:10),]   # I'm doing this to "separate" categories of `N` manually

p1 <- test1[,c(1,3:4)] %>%
  gather(col_name, value, -M) %>%
  ggplot(aes(factor(M), col_name, fill = value == 1)) 
  geom_tile(colour = 'black') 
  scale_fill_manual(values = c('FALSE' = 'white', 'TRUE' = 'red'))
p2 <- test2[,c(1,3:4)] %>%
  gather(col_name, value, -M) %>%
  ggplot(aes(factor(M), col_name, fill = value == 1)) 
  geom_tile(colour = 'black') 
  scale_fill_manual(values = c('FALSE' = 'white', 'TRUE' = 'yellow'))
p3 <- test3[,c(1,3:4)] %>%
  gather(col_name, value, -M) %>%
  ggplot(aes(factor(M), col_name, fill = value == 1)) 
  geom_tile(colour = 'black') 
  scale_fill_manual(values = c('FALSE' = 'white', 'TRUE' = 'green'))
p4 <- test4[,c(1,3:4)] %>%
  gather(col_name, value, -M) %>%
  ggplot(aes(factor(M), col_name, fill = value == 1)) 
  geom_tile(colour = 'black') 
  scale_fill_manual(values = c('FALSE' = 'white', 'TRUE' = 'blue'))

grid.arrange(p1, p2, p3, p4, ncol = 1)
  

Я прилагаю изображение того, что у меня есть прямо сейчас. Я хочу исправить эти графики так, чтобы у меня были одинаковые коэффициенты M для всех четырех графиков (прямо сейчас, только p1 и p4 все три фактора ( a , b и c ) на оси x, но я хочу добавить фактор c к p2 и a p3 , чтобы все оси x были идентичны друг другу. Кто-нибудь может дать мне предложения о том, как это сделать?

(Кроме того, я подозреваю, что текущий способ построения графиков, вероятно, не самый быстрый / простой способ, если у кого-нибудь есть предложения о том, как улучшить ситуацию, это было бы действительно полезно!)

Чтобы продолжить использовать grid.arrange() вместо facet_wrap() , выполните следующие действия:

Сделайте M коэффициент:

 test$M <- factor(test$M)
  

Добавьте следующее к каждому из ваших графиков:

 scale_x_discrete(limits = levels(test$M))
  

Возможно, один из подходов, который я могу вам предложить, заключается в использовании фасетов после применения хитрого трюка для группировки ваших значений и избежания разделения в разных фреймах данных. Вот код в качестве опции для вас (цвета будут одинаковыми для всех аспектов в базе TRUE/FALSE значений):

 library(tidyverse)
#Code
test %>% mutate(Var=lead(N)) %>%
  mutate(Diff=Var-N,Diff=ifelse(row_number()==1,0,Diff)) %>%
  mutate(Group=ifelse(Diff==0,N,NA)) %>%
  fill(Group) %>% select(-c(N,Var,Diff)) %>%
  group_by(Group) %>% mutate(NG=paste0('p',cur_group_id())) %>% ungroup() %>%
  select(-Group) %>%
  pivot_longer(cols = -c(NG,M)) %>%
  ggplot(aes(factor(M), name, fill = value == 1,group=value)) 
  geom_tile(colour = 'black') 
  facet_wrap(.~NG,ncol = 1) 
  scale_fill_manual('value',values=c('tomato','cyan3')) 
  xlab('M')
  

Вывод:

Другой вариант будет patchwork с настраиваемой функцией:

 library(tidyverse)
library(patchwork)
#Code
data <- test %>% mutate(Var=lead(N)) %>%
  mutate(Diff=Var-N,Diff=ifelse(row_number()==1,0,Diff)) %>%
  mutate(Group=ifelse(Diff==0,N,NA)) %>%
  fill(Group) %>% select(-c(N,Var,Diff)) %>%
  group_by(Group) %>% mutate(NG=paste0('p',cur_group_id())) %>% ungroup() %>%
  select(-Group) %>%
  mutate(M=factor(M,levels = unique(M),ordered = T)) %>%
  pivot_longer(cols = -c(NG,M))
#List
List <- split(data,data$NG)
#Function
myfun <- function(x)
{
  #Test for color
  val <- unique(x$NG)
  #Conditioning for color
  if(val=='p1') {vcolor=c('FALSE' = 'white', 'TRUE' = 'red')} else
    if(val=='p2') {vcolor=c('FALSE' = 'white', 'TRUE' = 'yellow')} else
      if(val=='p3') {vcolor=c('FALSE' = 'white', 'TRUE' = 'green')} else
      {vcolor=c('FALSE' = 'white', 'TRUE' = 'blue')}
  #Update data
  x <- x %>% mutate(M=factor(M,levels = c('a','b','c'),ordered = T)) %>% complete(M=M)
  #Plot
  G <- ggplot(x,aes(factor(M), name, fill = (value == 1 amp; !is.na(value)))) 
    geom_tile(colour = 'black') 
    scale_fill_manual('value',values=vcolor) 
    xlab('M') 
    scale_y_discrete(limits=c('X','Y')) 
    theme_bw() 
    ggtitle(val)
  return(G)
}
#Apply
Lplot <- lapply(List,myfun)
#Wrap
GF <- wrap_plots(Lplot,ncol = 1)
  

Вывод:

Что-то вроде этого?

 test<-data.frame("M"=c("a","b","c","a","b","b","c","a","b","c"), 
                 "N"=c(1,3,4,6,6,7,7,8,8,8), 
                 "X"=c(0,1,0,1,1,0,1,0,1,1), 
                 "Y"=c(1,1,0,0,1,0,1,1,1,0))

library(tidyverse)

test = mutate(test, N2 = cut(N, breaks = c(0,5:100)))    
m = pivot_longer(test, c(X, Y))

ggplot(m, aes(M, name,fill=factor(value)))  
    geom_tile(colour = 'black')  
    facet_wrap(~N2, scales = 'free')  
    scale_fill_manual(values = c(`0` = 'white', `1` = 'red'))