Wie mehrere ggplot2 Plots auszurichten und sie Schatten über alle

Question

Please download the data here!

Ziel hinzufügen: Plot ein Bild wie folgt aus:

Eigenschaften: 1 zwei verschiedene Zeitreihen; 2. das untere Feld hat eine umgekehrte y-Achse; 3. Schatten über zwei Plots.

Mögliche Lösungen:
1. Facettierung nicht geeignet ist - (1) kann nicht nur eine Facette der y-Achse machen umkehren, während die andere (n) unchanges halten. (2) schwierig, die einzelnen Facetten einzeln einzustellen.
2. Ansichtsfenster Mit einzelnen Parzellen ordnen Sie die folgenden 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)) 

Probleme:

1. die x-Achse ausrichten nicht richtig;
2. die Schattenpositionen sind falsch (wegen der falschen Anordnung der x-Achse).

Denn um Googeln:

1. Ich bemerkte zunächst, dass "align.plots() von ggExtra" diesen Job machen könnte. Es wurde jedoch vom Autor abgelehnt;
2. Dann habe ich versucht, die gglayout solution, aber kein Glück - ich konnte sogar nicht die "topaktuelle" Paket installieren;

3. Schließlich habe ich versucht, die gtable solution mit dem folgenden 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) 
   

nun die x-Achse der oberen und unteren Platte richtig tun auszurichten. Aber die Schattenpositionen sind immer noch falsch. Und noch wichtiger: Ich kann den Schatten-Plot auf den beiden Zeitreihen nicht überlappen. Nach mehreren Tagen versuche ich fast aufzugeben ...

Könnte mir jemand hier helfen?

Answer 1

Sie können dieses spezielle Diagramm auch mit nur Basis-Plotfunktionen erstellen.

#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 - Lösung mit ggplot2

Erstens, stellen zwei neue Datenrahmen, die für Rechtecke Informationen enthalten.

rect1<- data.frame (xmin=1100, xmax=1300, ymin=-Inf, ymax=Inf) 
rect2 <- data.frame (xmin=1800, xmax=1850, ymin=-Inf, ymax=Inf) 

ursprünglichen Plot Code geändert - bewegt data und aes nach innen geom_line(), fügte dann zwei geom_rect() Anrufe. Der wichtigste Teil ist plot.margin= in theme(). Für jedes Plot setze ich einen der Ränder auf -1 Zeile (obere für p1 und untere für p2) - das wird sicherstellen, dass Plot wird beitreten. Alle anderen Ränder sollten gleich sein. Bei p2 werden auch Achsen-Ticks entfernt. Dann lege beide Parzellen zusammen.

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) 

Answer 2

Hier ist eine Variation auf Didzis' Lösung, die die x-Achse in der Mitte bewahrt, und auch erlaubt im Prinzip der Umkehrung der y-Achse in der oberen Grafik (aber ich habe nicht implementieren das). Das Ergebnis ist dieses Diagramm:

Hier ist der Code. Es mag am unteren Ende etwas komplex aussehen, aber ich habe versucht, es so allgemein wie möglich zu schreiben. Wenn man bereit ist, die geeigneten Zellenpositionen usw. in gtable fest zu codieren, kann der Code viel kürzer sein. Anstatt Teile des Graphen über gtable abzuhacken, könnte man auch die Themen so verändern, dass die Stücke nicht zuerst gezeichnet werden. Das könnte auch kürzer sein.

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) 

Wir konnten die Top-y-Achse mit der Methode Reverse here. gezeigt