如何用R复制这个情节?

时间:2016-09-19 00:35:22

标签: r ggplot2 lattice

我需要制作几个时序图,其格式与图I所示的格式本身一样。

我将非常感谢你的帮助。

enter image description here

这是一个模拟数据的最小例子

    set.seed(1234)
    nobs<-50
    x<-rnorm(nobs,0,10)
    t<-seq(1,nobs)
    data<-ts(20+x+t, freq=4, start=c(2004,1))
    par(family="serif")
    plot(data, lwd=2, col="blue4", ylab="Millions")
    title(main="Gráfico 1. Evolución del ...")
    legend(2010,10,"GDP", col="blue4",lwd=2)
    abline(lm(data~t), lwd=2, col="red") # This does not work 

enter image description here

2 个答案:

答案 0 :(得分:6)

我假设您的数据是ts对象,如您的示例所示。这是一种使用base图形的方法。我们从最小的情节开始,然后在元素上分层。首先,最小的情节,确保在第1侧(即底部)留下大量空间:

par(mar = c(8, 4, 4, 2), family = "serif", las = 1)
plot(data, 
  frame = FALSE,
  xaxt = "n", 
  ylab = "Millones de pesos", xlab = "", 
  main = "Gráfico 1. Evolución del ...",
  col = "darkblue", lwd = 2)
fit <- forecast::tslm(data ~ trend)
lines(fitted(fit), col = "red", lwd = 2)

请注意,上面我们使用forecast::tslm来获取时间序列的时间趋势。现在,添加x轴元素。我使用mtext插入刻度标签:

axis(1, at = seq(2003.875, 2015.875, 1), tck = -.2, labels = FALSE)
mtext(rep(c("ener-mar", "abril-jun", "jul-sep", "oct-dic"), l = length(data)),
  side = 1, line = 0.25, las = 2,
  at = seq(tsp(data)[1], tsp(data)[2], by = 1/tsp(data)[3]),
  cex = .6)
mtext(2004:2016, side = 1, line = 3, at = seq(2004.3, 2016.3), cex = .7)
title(xlab = "Trimestres", line = 5, cex.lab = .8)

使用图例完成:

par(xpd = TRUE)
legend(2010, -27, c("PIB", "Tendencia PIB"), 
  bty = "n",
  xjust = .5,
  lty = c(1, 1),
  col = c("darkblue", "red"),
  cex = .7,
  horiz = TRUE)

输出: enter image description here

答案 1 :(得分:3)

这是一个ggplot2方法,接近你问题中的情节格式:

library(ggplot2)

# Fake data
set.seed(1234)
nobs<-52
t<-seq(1,nobs)
x<-rnorm(nobs,0,10) + t + 20
dat = data.frame(year=rep(2004:2016, each=4), qtr=rep(1:4, 13), x = x)

ggplot(dat, aes(paste(year,qtr), x)) +
  geom_vline(xintercept=seq(4.5,100,4), colour="grey80",lwd=0.3) +
  geom_line(aes(group=1)) +
  annotate(seq(2.5, 2.5 + 12*4, length.out=13), -2, label=2004:2016, 
           geom="text", colour="grey30", size=3.5) +
  theme_bw(base_size=10) +
  theme(axis.text.x=element_text(angl=-90, vjust=0.5, colour="grey30"),
        panel.grid.major.x=element_blank()) +
  scale_x_discrete(name="Quarter",
                   labels=rep(paste0(month.abb[seq(1,12,3)],"-",month.abb[seq(3,12,3)]),20)) +
  coord_cartesian(xlim=c(0,13*4 + 1), ylim=c(-4,max(dat$x + 2)), expand=FALSE) 

enter image description here

Facetting更接近你想要的格式,但是在正常的ggplot工作流程中没有办法(AFAIK)连接整个方面的线条。在下图中,垂直线显示每个方面之间的边界。 There are (somewhat complicated) ways尝试连接各个方面的线条,但在下面的示例中我没有做到这一点。

dat$qtr = rep(paste0(month.abb[seq(1,12,3)],"-",month.abb[seq(3,12,3)]),13)
dat$qtr = factor(dat$qtr, levels=paste0(month.abb[seq(1,12,3)],"-",month.abb[seq(3,12,3)]))

p=ggplot(dat, aes(qtr, x)) +
  geom_line(aes(group=1)) +
  coord_cartesian(xlim=c(0.5,4.5), expand=FALSE, ylim=c(-2,80)) +
  facet_grid(. ~ year, switch="x") +
  annotate(x=c(0.5, 4.5), xend=c(0.5,4.5), y=-16, yend=-2, geom="segment", 
           colour="grey70", size=0.3) +
  theme_bw(base_size=10) +
  theme(panel.margin=unit(0,"lines"),
        axis.text.x=element_text(angl=-90, vjust=0.5, colour="grey30"),
        panel.border=element_rect(colour="grey70", size=0.3),
        panel.grid.major=element_blank(),
        strip.background=element_rect(fill="grey90", colour="grey20"),
        axis.line=element_line(colour="black")) +
  labs(x="Quarter")

# Turn off clipping and draw plot
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[gt$layout$name=="panel"] <- "off"
grid.draw(gt)

enter image description here