कैसे कई ggplot2 भूखंडों संरेखित और

Question

Please download the data here!

लक्ष्य उनमें से सब कुछ खत्म हो छाया जोड़ने के लिए: प्लॉट एक छवि इस तरह:

विशेषताएं: 1 दो अलग-अलग समय श्रृंखला; 2. निचले पैनल में एक रिवर्स वाई-अक्ष है; 3. दो भूखंडों पर छाया।

संभावित समाधान:
1. Facetting उचित नहीं है - (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)) 

समस्याएं:

1. x- अक्ष सही ढंग से संरेखित नहीं करता है;
2. छाया स्थान गलत हैं (एक्स-अक्ष के गलत लाइन-अप के कारण)।

सभी चारों ओर Googling के बाद:

1. मैं सबसे पहले देखा "align.plots() ggExtra से" यह काम कर सकता है। हालांकि, इसे लेखक द्वारा बहिष्कृत कर दिया गया है;
2. फिर मैंने gglayout solution को आजमाया है, लेकिन कोई भाग्य नहीं - मैं "अत्याधुनिक" पैकेज भी इंस्टॉल नहीं कर सका;

3. अंत में, मैं gtable solution की कोशिश की है निम्नलिखित कोड का उपयोग कर:

   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- अक्ष सही ढंग से संरेखित है। लेकिन छाया की स्थिति अभी भी गलत है। और सबसे महत्वपूर्ण बात यह है कि मैं दो बार श्रृंखला पर छाया साजिश को ओवरलैप नहीं कर सकता। कई दिनों के प्रयासों के बाद, मैं लगभग छोड़ देता हूं ...

क्या कोई यहां मुझे हाथ दे सकता है?

Answer 1

आप केवल आधार साजिश कार्यों का उपयोग करके इस विशेष साजिश को भी प्राप्त कर सकते हैं।

#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) 

अद्यतन - 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() कॉल गयी। theme() में सबसे आवश्यक हिस्सा plot.margin= है। प्रत्येक साजिश के लिए मैंने मार्जिन में से एक को -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) 

Answer 2

यहाँ Didzis 'समाधान पर एक बदलाव है कि बीच में एक्स अक्ष को बरकरार रखता है, और भी सिद्धांत रूप में शीर्ष ग्राफ में y अक्ष के प्रत्यावर्तन की अनुमति देता है (लेकिन मैंने नहीं किया इसे लागू करें)।

यहाँ कोड है: परिणाम यह ग्राफ है। यह नीचे थोड़ा जटिल लग सकता है, लेकिन ऐसा इसलिए है क्योंकि मैंने इसे जितना संभव हो उतना सामान्य लिखने की कोशिश की। यदि कोई 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) 

हम विधि here.