【发布时间】：2016-06-06 14:16:50
【问题描述】：
类似问题How to align multiple ggplot2 plots and add shadows over all of them
我在上述问题上花了几天时间，但没有成功。
问题
我想在我的情节上添加一条垂直线。该怎么做？
数据
可以下载here或如下minidata
CHROM BIN_START BIN_END N_VARIANTS cashmere_PI noncashmere_PI Fst log2ratio log10ratio ratio
chr1 1 100000 83 0.000119082 0.000216189 0.0532838 0.860337761418733 0.25898747258944 1.81546329420064
chr1 50001 150000 72 9.67484e-05 0.00018054 0.0508251 0.90000880485528 0.27092964662313 1.86607737182217
chr1 100001 200000 56 7.98726e-05 0.000142246 0.0299909 0.832615502149238 0.250642241001749 1.78091110092823
chr1 150001 250000 62 8.53008e-05 0.00015624 0.0303362 0.873132677193208 0.262839126029552 1.831635811153
chr1 200001 300000 57 7.74641e-05 0.000133271 0.0405702 0.782763114550565 0.235635176979081 1.72042275066773
chr1 250001 350000 115 0.00015489 0.000186053 0.0662349 0.264469649364419 0.0796132974014257 1.20119439602298
chr1 300001 400000 118 0.00016185 0.000198862 0.0744181 0.29711025627991 0.0894390991596656 1.22868087735558
chr1 350001 450000 92 0.000125799 0.000228875 0.0581435 0.863439432015068 0.259921168475606 1.81937058323198
chr1 400001 500000 83 0.000110109 0.0002136 0.0561351 0.955979251468278 0.287778429924352 1.93989592131433
chr1 450001 550000 57 8.55834e-05 0.000148245 0.0909248 0.792580546810178 0.238590518569624 1.73217002362608
代码
pitab <- dget(file="dput")
library(ggplot2)
library(gtable)
library(gridExtra)
library(grid)
pitab <- pitab[pitab$Fst>0 & pitab$ratio > 0 , ]
dst <- density(pitab$Fst)
Fst.dst <- data.frame(Fst = dst$x, density = dst$y)
dens.pi <- density(pitab$log2ratio)
q975 <- quantile(pitab$log2ratio,0.975)
q025 <- quantile(pitab$log2ratio,0.025)
dd.pi <- with(dens.pi,data.frame(x,y))
dd.pi <- dd.pi[dd.pi$x>0 ,]
### top plot
top <- qplot(x,y,data=dd.pi, geom = "line") +
geom_ribbon(data=subset(dd.pi,x>q975), aes(ymax=y,xmax=max(pitab$log2ratio),xmin=0, ymin=0), fill="green", alpha=0.5)+
geom_ribbon(data=subset(dd.pi,x<q025), aes(ymax=y,xmax=max(pitab$log2ratio),xmin=0, ymin=0), fill="blue", alpha=0.5 ) +
geom_ribbon(data=subset(dd.pi,x>q025 & x<q975), aes(ymax=y,xmax=max(pitab$log2),xmin=0, ymin=0), fill="grey", alpha=0.5) +
geom_hline(yintercept=0,col="black",lwd=0.5) +
labs(x="log2ratio",y="density")
### empty plot on top right
empty <- ggplot()+geom_point(aes(1,1), colour="white")+
theme(axis.ticks=element_blank(),
panel.background=element_blank(),
axis.text.x=element_blank(), axis.text.y=element_blank(),
axis.title.x=element_blank(), axis.title.y=element_blank())
### scatter plot bottom left
q95 <- quantile(pitab$Fst, .95)
dd <- with(pitab,data.frame(Fst,log2ratio))
scatter <- ggplot(dd,aes(x=log2ratio,y=Fst)) +
geom_point(data=subset(dd, Fst > q95 & log2ratio < q025), aes(x=log2ratio,y=Fst,ymin=0,ymax=Fst,xmin=0,xmax=max(pitab$log2ratio)),colour="purple",alpha=0.8) +
geom_point(data=subset(dd, Fst > q95 & log2ratio > q975), aes(x=log2ratio,y=Fst,ymin=0,ymax=Fst,xmax=max(pitab$log2ratio),xmin=0),colour="yellow", alpha = 0.8) +
geom_point(data=subset(dd, !((Fst > q95 & log2ratio > q975) | (Fst > q95 & log2ratio < q025) ) ), aes(x=log2ratio,y=Fst,ymin=0,ymax=Fst,xmax=max(pitab$log2ratio),xmin=0),colour="black", alpha = 0.4)
## right plot ##
dens.f <- density(pitab$Fst)
q75 <- quantile(pitab$Fst, .75)
q95 <- quantile(pitab$Fst, .95)
dd.f <- with(dens.f,data.frame(x,y))
dd.f <- dd.f[dd.f$x > 0 ,]
#library(ggplot2)
right <- qplot(x,y,data=dd.f,geom="line")+
geom_ribbon(data=subset(dd.f,x>q95),aes(ymax=y),ymin=0,fill="red",colour=NA,alpha=0.5) +
geom_ribbon(data=subset(dd.f,x<q95),aes(ymax=y),ymin=0, fill="grey",colour=NA,alpha=0.5) +
geom_hline(yintercept=0,col="black",lwd=0.5) +
coord_flip()
#### the vline i want to add
line <- ggplot()+geom_vline(aes(1,1), xintercept = q025)
g.top <- ggplotGrob(top)
g.scatter <- ggplotGrob(scatter)
g.empty <- ggplotGrob(empty)
g.right <- ggplotGrob(right)
g.line <- ggplotGrob(line)
tab <- gtable(unit(rep(1, 3), "null"), unit(rep(1, 3), "null"))
tab <- gtable_add_grob(tab, g.top, t = 1, l = 1, r = 2)
tab <- gtable_add_grob(tab, g.scatter, t = 2 , l = 1, r=2,b=3)
tab <- gtable_add_grob(tab, g.empty,t=1,r=3,l=3)
tab <- gtable_add_grob(tab,g.right, r=3,t=2,b=3,l=3)
#tab <- gtable_add_grob(tab,g.line, r=2,t=1,b=3,l=1)
plot(tab)
我得到以下图片：
看起来不错！
但是，当我发布代码时：
tab <- gtable_add_grob(tab,g.line, r=2,t=1,b=3,l=1)
我只得到一条垂直线，顶部图和散点图已被覆盖。
我也尝试模仿克劳斯威尔克的解决方案，使用以下代码：
g.top <- ggplotGrob(top)
index <- subset(g.top$layout, name == "axis-b")
names <- g.top$layout$name[g.top$layout$t<=index$t]
g.top <- gtable_filter(g.top, paste(names, sep="", collapse="|"))
# set height of remaining, empty rows to 0
for (i in (index$t+1):length(g.top$heights))
{
g.top$heights[[i]] <- unit(0, "cm")
}
# Table g1 will be the bottom table. We chop off everything above the panel
g.scatter <- ggplotGrob(scatter)
index <- subset(g.scatter$layout, name == "panel")
# need to work with b here instead of t, to prevent deletion of background
names <- g.scatter$layout$name[g.scatter$layout$b>=index$b]
g.scatter <- gtable_filter(g.scatter, paste(names, sep="", collapse="|"))
# set height of remaining, empty rows to 0
for (i in 1:(index$b-1))
{
g.scatter$heights[[i]] <- unit(0, "cm")
}
# bind the two plots together
g.main <- rbind(g.top, g.scatter, size='first')
#grid.newpage()
#grid.draw(g.main)
# add the grob that holds the shadows
g.line <- gtable_filter(ggplotGrob(line), "panel") # extract the plot panel containing the shadows
index <- subset(g.main$layout, name == "panel") # locate where we want to insert the shadows
# find the extent of the two panels
t <- min(index$t)
b <- max(index$b)
l <- min(index$l)
r <- max(index$r)
# add grob
g.main <- gtable_add_grob(g.main, g.line, t, l, b, r)
# plot is completed, show
grid.newpage()
grid.draw(g.main)
但我只得到一条垂直线。
【问题讨论】：
-
请在您的问题中分享您的示例数据，而不是 Dropbox 链接。另外，将您的示例压缩为更小的示例。事实上，它应该只是说明问题所需的复杂程度。
-
@Roland ，感谢您的建议。我在我的问题中粘贴了 minidata。