Please download the data here!
Target: Plot an image like this:
Features: 1. two different time series; 2. the lower panel has a reverse y-axis; 3. shadows over two plots.
Possible solutions:
1. Facetting is not appropriate - (1) can not just make one facet's y axis reverse while keep the other(s) unchanges. (2) difficult to adjust the individual facets one by one.
2. Using viewports to arrange individual plots using the following codes:
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))
Problems:
- the x-axis doesn't align correctly;
- the shadow locations are wrong (because of the incorrect line-up of x-axis).
After Googling all around:
- I firstly noticed that "align.plots() from ggExtra" could do this job. However, it has been deprecated by the author;
- Then I've tried the gglayout solution, but no luck - I even could not install the "cutting-edge" package;
Finally, I've tried the gtable solution using the following code:
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)
Now, the x-axis of upper and lower panel do align correctly. But the shadow positions are still wrong. And more importantly, I can not overlap the shadow plot on the two time-series. After several day's attempts, I nearly give up...
Could somebody here give me a hand?
You can achieve this particular plot also using just base plotting functions.
#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 - Solution with ggplot2
First, make two new data frames that contain information for rectangles.
rect1<- data.frame (xmin=1100, xmax=1300, ymin=-Inf, ymax=Inf) rect2 <- data.frame (xmin=1800, xmax=1850, ymin=-Inf, ymax=Inf)
Modified your original plot code - moved data and aes to inside geom_line(), then added two geom_rect() calls. Most essential part is plot.margin= in theme(). For each plot I set one of margins to -1 line (upper for p1 and bottom for p2) - that will ensure that plot will join. All other margins should be the same. For p2 also removed axis ticks. Then put both plots together.
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)
Here is a variation on Didzis' solution that preserves the x axis in the middle, and also in principle allows the reversion of the y axis in the top graph (but I didn't implement that). The result is this graph:
Here is the code. It may look a bit complex at the bottom, but that's because I tried to write it as generic as possible. If one is willing to hard-code the appropriate cell locations etc. in gtable, the code can be much shorter. Also, instead of chopping off pieces of the graph via gtable, one could modify the themes so the pieces aren't drawn in the first place. That might also be shorter.
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)
We could reverse the top y axis using the method shown here.
