Save a ggplot2 time series plot grob generated by

问题:

This post describes a method to create a two-line x-axis (year below months) on a time series plot. Unfortunately, the method that I use from this post (option 2) is not compatible with ggsave().

library(tidyverse)
library(lubridate)

df <- tibble(
  date = as.Date(41000:42000, origin = "1899-12-30"), 
  value = c(rnorm(500, 5), rnorm(501, 10))
)

p <- ggplot(df, aes(date, value)) + 
  geom_line() + 
  geom_vline(
    xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60"
  ) + 
  scale_x_date(date_labels = "%b", date_breaks = "month", expand = c(0, 0)) + 
  theme_bw() +
  theme(panel.grid.minor.x = element_blank()) + 
  labs(x = "")

# Get the grob
g <- ggplotGrob(p)

# Get the y axis
index <- which(g$layout$name == "axis-b")  # which grob
xaxis <- g$grobs[[index]]

# Get the ticks (labels and marks)
ticks <- xaxis$children[[2]]

# Get the labels
ticksB <- ticks$grobs[[2]]

# Edit x-axis label grob
# Find every index of Jun in the x-axis labels and a year label
junes <- grep("Jun", ticksB$children[[1]]$label)
ticksB$children[[1]]$label[junes] <- 
  paste0(
    ticksB$children[[1]]$label[junes], 
    "\n            ",  # adjust the amount of spaces to center the year
    unique(year(df$date))
  ) 

# Center the month labels between ticks
ticksB$children[[1]]$label <- 
  paste0(
    paste(rep(" ", 12), collapse = ""),  # adjust the integer to center month
    ticksB$children[[1]]$label
  )

# Put the edited labels back into the plot
ticks$grobs[[2]] <- ticksB
xaxis$children[[2]] <- ticks
g$grobs[[index]] <- xaxis

# Draw the plot
grid.newpage()
grid.draw(g)

# Save the plot
ggsave("plot.png", width = 11, height = 8.5, units = "in")

A plot is saved, but without the years. How do I ggsave() the final plot from grid.draw(g)? This grid.draw(g) plot is shown below, but the actual plot.png file is slightly different, with the three years 2012, 2013 and 2014 omitted.

回答1:

library(tidyverse)
library(lubridate)
library(scales)

set.seed(123)
df <- tibble(
  date = as.Date(41000:42000, origin = "1899-12-30"), 
  value = c(rnorm(500, 5), rnorm(501, 10))
)

# create year column for facet
df <- df %>% 
  mutate(year = as.factor(year(date)))

p <- ggplot(df, aes(date, value)) + 
  geom_line() + 
  geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") + 
  scale_x_date(date_labels = "%b", 
               breaks = pretty_breaks(),
               expand = c(0, 0)) +
  # switch the facet strip label to the bottom
  facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
  labs(x = "") +
  theme_bw(base_size = 14, base_family = 'mono') +
  theme(panel.grid.minor.x = element_blank()) + 
  # remove facet spacing on x-direction
  theme(panel.spacing.x = unit(0,"line")) +
  # switch the facet strip label to outside 
  # remove background color
  theme(strip.placement = 'outside',
        strip.background.x = element_blank())
p

ggsave("plot.png", plot = p, 
       type = "cairo", 
       width = 11, height = 8.5, units = "in", 
       dpi = 150)

---

Using theme_classic()

p <- ggplot(df, aes(date, value)) + 
  geom_line() + 
  geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") + 
  scale_x_date(date_labels = "%b", 
               breaks = pretty_breaks(),
               expand = c(0, 0)) +
  # switch the facet strip label to the bottom
  facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
  labs(x = "") +
  theme_classic(base_size = 14, base_family = 'mono') +
  theme(panel.grid.minor.x = element_blank()) + 
  # remove facet spacing on x-direction
  theme(panel.spacing.x = unit(0,"line")) +
  # switch the facet strip label to outside 
  # remove background color
  theme(strip.placement = 'outside',
        strip.background.x = element_blank())
p

Add the top and right most borders

ymax <- ceiling(1.1 * max(df$value, na.rm = TRUE))
xmax <- max(df$date, na.rm = TRUE)

p <- ggplot(df, aes(date, value)) + 
  geom_line() + 
  geom_vline(xintercept = as.numeric(df$date[yday(df$date) == 1]), color = "grey60") + 
  scale_x_date(date_labels = "%b", 
               breaks = pretty_breaks(),
               expand = c(0, 0)) +
  # switch the facet strip label to the bottom
  facet_grid(.~ year, space = 'free_x', scales = 'free_x', switch = 'x') +
  labs(x = "") +
  theme_classic(base_size = 14, base_family = 'mono') +
  theme(panel.grid.minor.x = element_blank()) + 
  # remove facet spacing on x-direction
  theme(panel.spacing.x = unit(0,"line")) +
  # switch the facet strip label to outside 
  # remove background color
  theme(strip.placement = 'outside',
        strip.background.x = element_blank()) +
  ### add top and right most borders
  scale_y_continuous(expand = c(0, 0), limits = c(0, ymax)) +
  geom_hline(yintercept = ymax) +
  geom_vline(xintercept = as.numeric(df$date[df$date == xmax])) +
  theme(panel.grid.major = element_line())
p

^{Created on 2018-10-01 by the reprex package (v0.2.1.9000)}

回答2:

Taken from Tung comments above. Add the following at the end of the code chunk in the op's question.

ggsave(
  "plot.png", 
  plot = g, 
  type = "cairo", 
  width = 11, 
  height = 8.5, 
  units = "in", 
  dpi = 150
  )