请在此下载的数据!
目标:情节是这样的图像:
产品特点:1,两个不同的时间序列; 2.在下面板具有反向y轴; 3.阴影在两个地块。
可能的解决方案:
1.磨制是不恰当的 - (1)不能只是做一个小的Y轴反转,而保留其他(一个或多个)unchanges。 (2)很难调整各个小面一个接一个。
2.使用视使用下面的代码来安排个别地块:
library(ggplot2)
library(grid)
library(gridExtra)
##Import data
df<- read.csv("D:\\R\\SF_Question.csv")
##Draw individual plots
#the lower panel
p1<- ggplot(df, aes(TIME1, VARIABLE1)) + geom_line() + scale_y_reverse() + labs(x="AGE") + scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000))
#the upper panel
p2<- ggplot(df, aes(TIME2, V2)) + geom_line() + labs(x=NULL) + scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000)) + theme(axis.text.x=element_blank())
##For the shadows
#shadow position
rects<- data.frame(x1=c(1100,1800),x2=c(1300,1850),y1=c(0,0),y2=c(100,100))
#make shadows clean (hide axis, ticks, labels, background and grids)
xquiet <- scale_x_continuous("", breaks = NULL)
yquiet <- scale_y_continuous("", breaks = NULL)
bgquiet<- theme(panel.background = element_rect(fill = "transparent", colour = NA))
plotquiet<- theme(plot.background = element_rect(fill = "transparent", colour = NA))
quiet <- list(xquiet, yquiet, bgquiet, plotquiet)
prects<- ggplot(rects,aes(xmin=x1,xmax=x2,ymin=y1,ymax=y2))+ geom_rect(alpha=0.1,fill="blue") + coord_cartesian(xlim = c(1000, 2000)) + quiet
##Arrange plots
pushViewport(viewport(layout = grid.layout(2, 1)))
vplayout <- function(x, y)
viewport(layout.pos.row = x, layout.pos.col = y)
#arrange time series
print(p2, vp = vplayout(1, 1))
print(p1, vp = vplayout(2, 1))
#arrange shadows
print(prects, vp=vplayout(1:2,1))
问题:
- x轴不能正确对齐;
- 阴影的位置是错误的(因为x轴的不正确的阵容)。
四周后,谷歌搜索:
- 我首先注意到,“()从ggExtra align.plots”能做到这一点的工作。 然而,这种模式已经过时的作者;
- 然后,我已经试过了gglayout的解决方案 ,但没有运气-我甚至无法安装“新锐”包;
最后,我已经试过gtable解决方案使用下面的代码:
gp1<- ggplot_gtable(ggplot_build(p1)) gp2<- ggplot_gtable(ggplot_build(p2)) gprects<- ggplot_gtable(ggplot_build(prects)) maxWidth = unit.pmax(gp1$widths[2:3], gp2$widths[2:3], gprects$widths[2:3]) gp1$widths[2:3] <- maxWidth gp2$widths[2:3] <- maxWidth gprects$widths[2:3] <- maxWidth grid.arrange(gp2, gp1, gprects)
现在,上部和下部面板的x轴不正确对齐。 但是阴影位置仍然是错误的。 更重要的是,我不能重叠的两个时间序列的影子阴谋。 几天的尝试后,我几乎放弃了......
在这里可以有人给我个忙吗?
可以实现也只用图基绘图函数这个特殊的情节。
#Set alignment for tow plots. Extra zeros are needed to get space for axis at bottom.
layout(matrix(c(0,1,2,0),ncol=1),heights=c(1,3,3,1))
#Set spaces around plot (0 for bottom and top)
par(mar=c(0,5,0,5))
#1. plot
plot(df$V2~df$TIME2,type="l",xlim=c(1000,2000),axes=F,ylab="")
#Two rectangles - y coordinates are larger to ensure that all space is taken
rect(1100,-15000,1300,15000,col="red",border="red")
rect(1800,-15000,1850,15000,col="red",border="red")
#plot again the same line (to show line over rectangle)
par(new=TRUE)
plot(df$V2~df$TIME2,type="l",xlim=c(1000,2000),axes=F,ylab="")
#set axis
axis(1,at=seq(800,2200,200),labels=NA)
axis(4,at=seq(-15000,10000,5000),las=2)
#The same for plot 2. rev() in ylim= ensures reverse axis.
plot(df$VARIABLE1~df$TIME1,type="l",ylim=rev(range(df$VARIABLE1)+c(-0.1,0.1)),xlim=c(1000,2000),axes=F,ylab="")
rect(1100,-15000,1300,15000,col="red",border="red")
rect(1800,-15000,1850,15000,col="red",border="red")
par(new=TRUE)
plot(df$VARIABLE1~df$TIME1,type="l",ylim=rev(range(df$VARIABLE1)+c(-0.1,0.1)),xlim=c(1000,2000),axes=F,ylab="")
axis(1,at=seq(800,2200,200))
axis(2,at=seq(-6.4,-8.4,-0.4),las=2)
UPDATE - 解决方案与GGPLOT2
首先,包含了矩形信息的两个新的数据帧。
rect1<- data.frame (xmin=1100, xmax=1300, ymin=-Inf, ymax=Inf)
rect2 <- data.frame (xmin=1800, xmax=1850, ymin=-Inf, ymax=Inf)
修改您的原创情节码-移动data
和aes
里面geom_line()
然后添加了两个geom_rect()
调用。 最重要的部分是plot.margin=
在theme()
对于每个情节我设置页边距的一个-1
线(上为p1
和底部p2
) -这将确保情节将加入。 所有其他的利润率应该是相同的。 对于p2
也取出轴线蜱。 然后把两个图一起。
library(ggplot2)
library(grid)
library(gridExtra)
p1<- ggplot() + geom_line(data=df, aes(TIME1, VARIABLE1)) +
scale_y_reverse() +
labs(x="AGE") +
scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000)) +
geom_rect(data=rect1,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
geom_rect(data=rect2,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
theme(plot.margin = unit(c(-1,0.5,0.5,0.5), "lines"))
p2<- ggplot() + geom_line(data=df, aes(TIME2, V2)) + labs(x=NULL) +
scale_x_continuous(breaks = seq(1000,2000,200), limits = c(1000,2000)) +
scale_y_continuous(limits=c(-14000,10000))+
geom_rect(data=rect1,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
geom_rect(data=rect2,aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),alpha=0.1,fill="blue")+
theme(axis.text.x=element_blank(),
axis.title.x=element_blank(),
plot.title=element_blank(),
axis.ticks.x=element_blank(),
plot.margin = unit(c(0.5,0.5,-1,0.5), "lines"))
gp1<- ggplot_gtable(ggplot_build(p1))
gp2<- ggplot_gtable(ggplot_build(p2))
maxWidth = unit.pmax(gp1$widths[2:3], gp2$widths[2:3])
gp1$widths[2:3] <- maxWidth
gp2$widths[2:3] <- maxWidth
grid.arrange(gp2, gp1)
下面是保留在中间的x轴,以及在原理允许在顶部曲线图中的y轴的逆转上Didzis'溶液的变化(但是我没有实现这一点)。 结果是这样的图:
下面是代码。 它可以在底部看起来有点复杂,但是那是因为我试图把它写尽可能地通用。 如果一个人愿意进行硬编码的相应单元格位置等在gtable,代码可以短得多。 此外,而不是通过gtable斩去图的碎片,一个可以修改的主题,这样的作品没有在第一时间绘制。 这也可能更短。
require(cowplot)
data <- read.csv("SF_Question.csv")
# create top plot
p2 <- ggplot(data, aes(x=TIME2, y=V2)) + geom_line() + xlim(1000, 2000) +
ylab("Variable 2") + theme(axis.text.x = element_blank())
# create bottom plot
p1 <- ggplot(data = data, aes(x=TIME1, y=VARIABLE1)) + geom_line() +
xlim(1000, 2000) + ylim(-6.4, -8.4) + xlab("Time") + ylab("Variable 1")
# create plot that will hold the shadows
data.shadows <- data.frame(xmin = c(1100, 1800), xmax = c(1300, 1850), ymin = c(0, 0), ymax = c(1, 1))
p.shadows <- ggplot(data.shadows, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax)) +
geom_rect(fill='blue', alpha='0.5') +
xlim(1000, 2000) + scale_y_continuous(limits = c(0, 1), expand = c(0, 0))
# now combine everything via gtable
require(gtable)
# Table g2 will be the top table. We chop off everything below the axis-b
g2 <- ggplotGrob(p2)
index <- subset(g2$layout, name == "axis-b")
names <- g2$layout$name[g2$layout$t<=index$t]
g2 <- gtable_filter(g2, paste(names, sep="", collapse="|"))
# set height of remaining, empty rows to 0
for (i in (index$t+1):length(g2$heights))
{
g2$heights[[i]] <- unit(0, "cm")
}
# Table g1 will be the bottom table. We chop off everything above the panel
g1 <- ggplotGrob(p1)
index <- subset(g1$layout, name == "panel")
# need to work with b here instead of t, to prevent deletion of background
names <- g1$layout$name[g1$layout$b>=index$b]
g1 <- gtable_filter(g1, paste(names, sep="", collapse="|"))
# set height of remaining, empty rows to 0
for (i in 1:(index$b-1))
{
g1$heights[[i]] <- unit(0, "cm")
}
# bind the two plots together
g.main <- rbind(g2, g1, size='first')
# add the grob that holds the shadows
g.shadows <- gtable_filter(ggplotGrob(p.shadows), "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.shadows, t, l, b, r)
# plot is completed, show
grid.newpage()
grid.draw(g.main)
我们可以扭转顶部Y轴采用所示的方法在这里。