Save a ggplot2 time series plot grob generated by

2019-01-15 21:35发布

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.

enter image description here

2条回答
狗以群分
2楼-- · 2019-01-15 22:01
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)

查看更多
戒情不戒烟
3楼-- · 2019-01-15 22:12

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
  )
查看更多
登录 后发表回答