如何用 R 复制这个图？

Question

我需要制作几个时间序列图，格式如图所示。我对格式本身很感兴趣。

我会很感激你的帮助。

这是一个带有模拟数据的最小示例

    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

Answer 1

这里有一个 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)

Facetting 更接近您想要的格式，但在正常的 ggplot 工作流程中没有办法（AFAIK）连接各个方面的线条。在下图中，垂直线显示了每个面之间的边界。尝试跨面连接线，但在下面的示例中我没有做到那么远。

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)

Answer 2

我假设您的数据是一个 ts 对象，如您的示例所示。这是一种使用 base 图形的方法。我们从一个最小的情节开始，然后在元素上分层。首先，最小的情节，确保在第 1 侧（即底部）留下很多 space：

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)

输出：

如何用 R 复制这个图？

How to replicate this plot with R?

r

ggplot2

lattice