Сохраните гроб графика временных рядов ggplot2, сгенерированный ggplotGrob - PullRequest
0 голосов
/ 28 сентября 2018

В этом посте описан метод для создания двухстрочной оси X (год под месяцами) на графике временного ряда.К сожалению, метод, который я использую из этого поста ( опция 2 ), не совместим с 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")

График сохраняется, но без лет.Как мне ggsave() окончательный сюжет от grid.draw(g)?Этот график grid.draw(g) показан ниже, но фактический файл plot.png немного отличается, за исключением трех лет 2012, 2013 и 2014.

enter image description here

Ответы [ 2 ]

0 голосов
/ 02 октября 2018
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)


Использование 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

Добавить верхнюю и правую большинство границ

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

Создано в 2018-10-01 для представительного пакета (v0.2.1.9000)

0 голосов
/ 01 октября 2018

Взято из Tung комментариев выше.Добавьте следующий код в конце фрагмента кода в вопросе опера.

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