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

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 или { {X4}} равно 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)

the plot I have after running the code above

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

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

4
Jen 7 Окт 2020 в 23:12

3 ответа

Лучший ответ

Возможно, один из подходов, который я могу вам предложить, - это использовать фасеты после применения умного трюка, чтобы сгруппировать ваши значения и избежать разделения на разные фреймы данных. Вот код как вариант для вас (цвета будут одинаковыми для всех аспектов на основе значений 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')

Выход:

enter image description here

Другой вариант - 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 & !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)

Выход:

enter image description here

1
Duck 7 Окт 2020 в 21:16

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

Сделайте M фактором:

test$M <- factor(test$M)

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

scale_x_discrete(limits = levels(test$M))

enter image description here

1
Ben Norris 7 Окт 2020 в 20:42

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

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'))
0
Johan 7 Окт 2020 в 20:44