Установите высоту оси Y графиков в grid.arrange, но не всей области графика

При использовании сетки я столкнулся со следующей проблемой: график начальной проблемыЯ хочу, чтобы все мои панели (a,b,c ) иметь одинаковый размер, но поскольку я удалил метки и отметки с панелей a и b (чтобы иметь только одну ось x), размер графиков a и b больше и равен размеру графика c + пробел для ярлыка и отметок c. Я также не могу использовать ggplot2::facet_grid, так как я хочу указать пределы по оси Y независимо (например, для a до 40 и для b и c до 15). Ниже вы можете найти рабочий пример, используемый для создания этого графика, на основе этот пост чтобы выровнять графики по вертикали, но я понятия не имею, как обеспечить одинаковую высоту каждого графика по отдельности. Любые указатели приветствуются.

library(ggplot2)
library(gridExtra)


# generate data  
data <- data.frame(values=c(runif(20,0,40),runif(40,0,15)),product=c(rep("a",20),rep("b",20),rep("c",20)),treat=c("e","f","g","h","i"),time=c(0,6,24,48))

my_labeller <- function(var, value){
  value <- as.character(value)
  value <- c("a","b","c")
  return(value)
}


#subset data
data_a <- data[1:20,]
data_b <- data[21:40,]
data_c <- data[41:60,]

# Make plots for all parameters seperatly:

p_a <- ggplot(data_a,fill = white,
                 aes(x=as.numeric(as.character(time)),y=as.numeric(as.character(values))))
p_a <- p_a+ geom_point(aes(colour=treat,shape=treat),size=4)
p_a <- p_a + geom_line(aes(colour=treat))
p_a <- p_a + theme(axis.ticks.x = element_line(colour = "grey"), 
                     axis.ticks.y =element_line(colour = "grey"),
                     panel.background = element_rect(fill = "white"),
                     panel.grid.major=element_blank(),
                     panel.grid.minor=element_blank(),
                     axis.line = element_line(colour = "grey"),
                     axis.text.x = element_text(size = 15),
                     axis.text.y = element_text(size = 15),
                     axis.title.x = element_text(size =18),
                     axis.title.y = element_text(size=18,angle=0),
                     legend.text = element_text(size=15),
                     legend.title = element_blank(),
                     legend.position = "right"

)

p_a <- p_a + scale_colour_manual(values = c("#FFFF55","#000000","#0000AA","#00AA00","#00AAAA"), breaks= c("e","f","g","h","i"), 
                                   labels = c("e","f","g","h","i")
) 
p_a <- p_a + scale_shape_manual(values =c(15:18,8), breaks= c("e","f","g","h","i"), 
                                labels = c("e","f","g","h","i") 
)

p_a <- p_a  + guides(color = guide_legend(nrow=5),size = 16)

# p <- p+ guides(colour="legend",size="none",shape= "legend")

p_a <- p_a + scale_x_continuous(breaks= c(0,6,24,48))
p_a <- p_a + xlab("Time (h)") + ylab(paste(data_a$product, "(mM)"))
p_a <- p_a + ylim(0,40)
print(p_a)



p_b <- ggplot(data_b,fill = white,
              aes(x=as.numeric(as.character(time)),y=as.numeric(as.character(values))))
p_b <- p_b+ geom_point(aes(colour=treat,shape=treat),size=4)
p_b <- p_b + geom_line(aes(colour=treat))
p_b <- p_b + theme(axis.ticks.x = element_line(colour = "grey"), 
                   axis.ticks.y =element_line(colour = "grey"),
                   panel.background = element_rect(fill = "white"),
                   panel.grid.major=element_blank(),
                   panel.grid.minor=element_blank(),
                   axis.line = element_line(colour = "grey"),
                   axis.text.x = element_text(size = 15),
                   axis.text.y = element_text(size = 15),
                   axis.title.x = element_text(size =18),
                   axis.title.y = element_text(size=18,angle=0),
                   legend.text = element_text(size=15),
                   legend.title = element_blank(),
                   legend.position = "right"

)

p_b <- p_b + scale_colour_manual(values = c("#FFFF55","#000000","#0000AA","#00AA00","#00AAAA"), breaks= c("e","f","g","h","i"), 
                                 labels = c("e","f","g","h","i")
) 
p_b <- p_b + scale_shape_manual(values =c(15:18,8), breaks= c("e","f","g","h","i"), 
                                labels = c("e","f","g","h","i") 
)

p_b <- p_b  + guides(color = guide_legend(nrow=5),size = 16)

# p <- p+ guides(colour="legend",size="none",shape= "legend")

p_b <- p_b + scale_x_continuous(breaks= c(0,6,24,48))
p_b <- p_b + xlab("Time (h)") + ylab(paste(data_b$product, "(mM)"))
p_b <- p_b + ylim (0,15)
print(p_b)




p_c <- ggplot(data_c,fill = white,
              aes(x=as.numeric(as.character(time)),y=as.numeric(as.character(values))))
p_c <- p_c+ geom_point(aes(colour=treat,shape=treat),size=4)
p_c <- p_c + geom_line(aes(colour=treat))
p_c <- p_c + theme(axis.ticks.x = element_line(colour = "grey"), 
                   axis.ticks.y =element_line(colour = "grey"),
                   panel.background = element_rect(fill = "white"),
                   panel.grid.major=element_blank(),
                   panel.grid.minor=element_blank(),
                   axis.line = element_line(colour = "grey"),
                   axis.text.x = element_text(size = 15),
                   axis.text.y = element_text(size = 15),
                   axis.title.x = element_text(size =18),
                   axis.title.y = element_text(size=18,angle=0),
                   legend.text = element_text(size=15),
                   legend.title = element_blank(),
                   legend.position = "right"

)

p_c <- p_c + scale_colour_manual(values = c("#FFFF55","#000000","#0000AA","#00AA00","#00AAAA"), breaks= c("e","f","g","h","i"), 
                                 labels = c("e","f","g","h","i")
) 
p_c <- p_c + scale_shape_manual(values =c(15:18,8), breaks= c("e","f","g","h","i"), 
                                labels = c("e","f","g","h","i") 
)

p_c <- p_c  + guides(color = guide_legend(nrow=5),size = 16)

# p <- p+ guides(colour="legend",size="none",shape= "legend")

p_c <- p_c + scale_x_continuous(breaks= c(0,6,24,48))
p_c <- p_c + xlab("Time (h)") + ylab(paste(data_c$product, "(mM)"))
p_c <- p_c + ylim (0,15)
print(p_c)

# now remove space in between a and b and b and c

p_a <- p_a + theme(plot.margin = rep(unit(0,"null"),4),
                     panel.margin = unit(0,"null"),
                     axis.ticks.length = unit(0,"null"),
                     axis.ticks.margin = unit(0,"null")) +
  labs(x=NULL) + 
  scale_x_discrete(breaks=NULL) + 
  guides(fill=FALSE)

p_b <- p_b + theme(plot.margin = rep(unit(0,"null"),4),
                         panel.margin = unit(0,"null"),
                         axis.ticks.length = unit(0,"null"),
                         axis.ticks.margin = unit(0,"null")) +
  labs(x=NULL) + 
  scale_x_discrete(breaks=NULL) + 
  guides(fill=FALSE)

p_c <- p_c + theme(plot.margin = rep(unit(0,"null"),4),
                           panel.margin = unit(0,"null"))

# arrange them (+ align) 

plots <- list(p_a,p_b,p_c)
grobs <- list()
widths <- list()


for (i in 1:length(plots)){
  grobs[[i]] <- ggplotGrob(plots[[i]])
  widths[[i]] <- grobs[[i]]$widths[2:5]
}

maxwidth <- do.call(grid::unit.pmax, widths)

for (i in 1:length(grobs)){
  grobs[[i]]$widths[2:5] <- as.list(maxwidth)
}


do.call("grid.arrange", c(grobs, ncol = 1))

Я использую R в Linux. Вывод моего session.Info():

R version 3.1.1 (2014-07-10)
Platform: x86_64-pc-linux-gnu (64-bit)

locale:
 [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C         LC_TIME=C            LC_COLLATE=C         LC_MONETARY=C        LC_MESSAGES=C        LC_PAPER=C           LC_NAME=C           
 [9] LC_ADDRESS=C         LC_TELEPHONE=C       LC_MEASUREMENT=C     LC_IDENTIFICATION=C 

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] gridExtra_0.9.1 ggvis_0.4       fastmatch_1.0-4 dplyr_0.3.0.2   shiny_0.10.2.1  xlsx_0.5.7      xlsxjars_0.6.1  rJava_0.9-6     ggplot2_1.0.0   reshape2_1.4    gdata_2.13.3   

loaded via a namespace (and not attached):
 [1] DBI_0.3.1        MASS_7.3-35      R6_2.0.1         RJSONIO_1.3-0    Rcpp_0.11.3      assertthat_0.1   colorspace_1.2-4 digest_0.6.4     gtable_0.1.2     gtools_3.4.1    
[11] htmltools_0.2.6  httpuv_1.3.2     labeling_0.3     magrittr_1.0.1   mime_0.2         munsell_0.4.2    parallel_3.1.1   plyr_1.8.1       proto_0.3-10     scales_0.2.4    
[21] stringr_0.6.2    tools_3.1.1      xtable_1.7-4

person FM Kerckhof    schedule 08.12.2014    source источник
comment
Пробовали ли вы использовать ggplot2::facet_grid(scales=free_y) или вам нужно вручную указать разные пределы y, а не генерировать их автоматически?   -  person mmk    schedule 10.12.2014
comment
Нам нужно установить масштабы вручную, так как если мы используем scales = free_y, мы получим этот небрежный результат (см.: bit.ly/1yyEd5C), где графики b и c имеют разный масштаб, тогда как я хотел бы, чтобы они находились в диапазоне от 0 до 15 мМ.   -  person FM Kerckhof    schedule 10.12.2014


Ответы (2)


Вы должны использовать rbind вместо grid.arrange,

plots <- list(p_a, p_b, p_c)
grobs <- lapply(plots, ggplotGrob)
# for gridExtra < v2.3, use do.call(gridExtra::rbind.gtable, grobs)
# for gridExtra >= v2.3 use:
g <- do.call(gridExtra::gtable_rbind, grobs)

library(grid)
grid.newpage()
grid.draw(g)
person baptiste    schedule 10.12.2014
comment
Я получаю сообщение об ошибке: Ошибка: «rbind» не является экспортированным объектом из «пространства имен: gridExtra». Я установил самую последнюю версию gridExtra... я что-то упустил? - person Nova; 05.10.2016

Одним из приемов может быть использование facet_grid с scales = "free_y" и добавление некоторых «невидимых» данных, которые будут использоваться, когда ggplot автоматически генерирует пределы по оси Y. Это будет работать, если вы хотите расширить автоматически сгенерированные оси за пределы ваших данных, но не если вы хотите ограничить их, чтобы исключить часть ваших данных:

data <- data.frame(values=c(runif(20,0,40),runif(40,0,15)),
           product=c(rep("a",20),rep("b",20),rep("c",20)),
           treat=c("e","f","g","h","i"),
           time=c(0,6,24,48))

ggplot(data, aes(time, values, color=treat)) + 
      geom_line() + geom_point() +
      geom_hline(data=data.frame(product=c("a", "b", "c"), values=c(40, 15, 15)), 
             aes(yintercept=values), color="white") +
      facet_grid(product~., scales="free") +
      theme(panel.background=element_blank(), panel.grid=element_blank())

введите здесь описание изображения

person mmk    schedule 10.12.2014