ti-enxame.com

Como alinhar vários gráficos do ggplot2 e adicionar sombras sobre todos eles

Faça o download dos dados aqui!

Alvo: Plote uma imagem como esta:

this

Características: 1. duas séries temporais diferentes; 2. o painel inferior possui um eixo y reverso; 3. sombras sobre duas parcelas.

Possíveis soluções:
1. Facetamento não é apropriado 1) não pode apenas reverter o eixo y de uma faceta enquanto mantém a outra (s) inalterada. (2) difícil ajustar as facetas individuais uma a uma.
2. Usando viewports para organizar plotagens individuais usando os seguintes códigos:

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

this

Problemas:

  1. o eixo x não está alinhado corretamente;
  2. os locais das sombras estão incorretos (devido à formação incorreta do eixo x).

Depois de pesquisar no Google todo:

  1. Primeiro, notei que "align.plots () from ggExtra" poderia fazer este trabalho. No entanto, foi preterido pelo autor;
  2. Então tentei a --- (solução gglayout , mas sem sorte - nem consegui instalar o pacote "Cutting-Edge";
  3. Por fim, tentei o solução gtable usando o seguinte código:

    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)
    

this

Agora, o eixo x do painel superior e inferior está alinhado corretamente. Mas as posições das sombras ainda estão erradas. E, mais importante, não posso sobrepor o gráfico das sombras nas duas séries temporais. Depois de várias tentativas de dia, eu quase desisto ...

Alguém aqui poderia me dar uma mão?

33
bearcat

Você pode obter esse gráfico específico também usando apenas as funções básicas de plotagem.

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

enter image description here

UPDATE - Solução com ggplot2

Primeiro, crie dois novos quadros de dados que contenham informações para retângulos.

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

Modificado seu código de plotagem original - movido data e aes para dentro de geom_line() e, em seguida, adicionadas duas chamadas geom_rect(). A parte mais essencial é plot.margin= Em theme(). Para cada plotagem, defino uma das margens para a linha -1 (Superior para p1 E inferior para p2) - para garantir que a plotagem se junte. Todas as outras margens devem ser as mesmas. Para p2 Também foram removidos os tiquetaques dos eixos. Em seguida, monte as duas parcelas.

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)

enter image description here

34
Didzis Elferts

Aqui está uma variação da solução de Didzis que preserva o eixo x no meio, e também em princípio permite a reversão do eixo y no gráfico superior (mas não implementei isso). O resultado é este gráfico:

enter image description here

Aqui está o código. Pode parecer um pouco complexo na parte inferior, mas foi porque tentei escrever o mais genérico possível. Se alguém quiser codificar os locais apropriados das células etc. no gtable, o código poderá ser muito menor. Além disso, em vez de cortar partes do gráfico via gtable, é possível modificar os temas para que as peças não sejam desenhadas em primeiro lugar. Isso também pode ser mais curto.

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)

Poderíamos reverter o eixo y superior usando o método mostrado aqui.

9
Claus Wilke