ggplot2:添加辅助 x 标签(年份低于月份)

ggplot2: Add secondary x label (year below months)

我的问题与:

但是,我的数据看起来有点不同。

library(dplyr)

set.seed(122)
df <- as_tibble(rlnorm(1260, meanlog = 0.06, sdlog = 0.20))

df$month <- rep(c("Jan", "Feb", "Mär", "Apr", "Mai", "Jun", 
      "Jul", "Aug", "Sep", "Okt", "Nov", "Dez"), 5, each=21)

df$year <- rep(c("Year 1", "Year 2", "Year 3", "Year 4", "Year 5" ), 1, each=252)

我希望我的折线图也像这样,但如果可能的话没有垂直线:

我可以想到两种方法来做到这一点,每种方法各有利弊:

数据准备:

library(dplyr)
library(tibble)
library(lubridate)
library(scales)
library(ggplot2)

set.seed(122)
df <- as_tibble(rlnorm(1260, meanlog = 0.06, sdlog = 0.20))
df$month <- rep(month.abb, 5, each=21)
df$year <- rep(c("Year 1", "Year 2", "Year 3", "Year 4", "Year 5"), 1, each=252)

# We first create a "real" date variable with year, month and day. I've chosen to add 
# "201" in from of your year, but it really doesn't matter in our case.
df <- df %>%
  group_by(year, month) %>%
  mutate(Date = as.Date(paste0("201", sub("^.+(\d+)$", "\1", year),
                               "-", month, "-", row_number()),
                        format = "%Y-%b-%d"))

# Since OP's daily values don't make up full months of data, 
# we need this step to show missing data correctly. 
df <- expand.grid(Date = seq.Date(from = min(df$Date), to = max(df$Date), by = "days")) %>% 
  mutate(year = paste("Year", sub("^\d{3}(\d)", "\1", format(Date, "%Y"))),
         month = format(Date, "%b")) %>%
  left_join(df)

请注意,我使用 month.abb 替换了 OP 提供的月份,因为看起来他们使用的是 non-English 语言环境。

1。使用 facet_grid:

ggplot(df, aes(x = Date, y = value, group = year)) +
  geom_line() +
  facet_grid(. ~ year, scale = "free_x") +
  scale_x_date(labels = date_format("%b"), expand = c(0, 0)) +
  theme(panel.spacing.x = unit(0, "lines")) +
  ylim(c(0, 2.5))

我在 scale_x_date 中使用 expand 来防止 ggplot 在每个面的两端添加空格,并使用 panel.spacing.x 来减少面之间的间距。这两者的组合给我们一种错觉,面板是相连的,但实际上它们不是(即使没有缺失值,每个面的末尾也不会连接到下一个面的开始)

2。使用 geom_rect + geom_text:

# Create labels
label_range <- df %>%
  group_by(year) %>%
  summarize(xmin = min(Date),
            xmax = max(Date),
            ymin = -0.5,
            ymax = ymin + 0.15)

ggplot(df) +
  geom_line(aes(x = Date, y = value)) +
  geom_rect(data = label_range, fill = "lightcoral", color = "#f2f2f2",
            aes(xmin = xmin, xmax = xmax, 
                ymin = ymin, ymax = ymax,
                group = year)) +
  geom_text(data = label_range,
            aes(x = xmin + 365/2, y = ymin + 0.1,
                group = year, label = year)) +
  coord_cartesian(ylim = c(0, 2.5), clip = "off") +
  scale_x_date(labels = date_format("%b"), 
               date_breaks = "1 month",
               expand = c(0.01, 0.01)) +
  theme_bw() +
  theme(plot.margin = unit(c(1,1,3,1), "lines"))

第二种方法比较繁琐,但我们的数据将被视为一个连续的系列。

  1. 创建label_range确定每个geom_rect的四个角的坐标。

  2. 使用此数据集,我使用 geom_rect 绘制了 "facet boxes",并使用按 year 分组的 geom_text 绘制了它们的标签。

  3. 我们希望矩形在 x-axis 下方,所以我使用 coord_cartesian 将绘图设置为特定的缩放比例,这样可以防止我们的矩形在我们进行裁剪时被剪掉将其设置在情节之外。

  4. plot.margin 在 x-axis 下面为我们的分面标签添加一些空格

  5. 注意 DecJan 之间的差距。它们是由缺失值引起的,这与第一种方法中DecJan之间的差距不同。

library(tidyverse)

#data:
set.seed(122)
df <- as_tibble(rlnorm(1260, meanlog = 0.06, sdlog = 0.20))
#> Warning: Calling `as_tibble()` on a vector is discouraged, 
#> because the behavior is likely to change in the future. 
#> Use `tibble::enframe(name = NULL)` instead.

df$month <- rep(c("Jan", "Feb", "Mär", "Apr", "Mai", "Jun", 
                  "Jul", "Aug", "Sep", "Okt", "Nov", "Dez"), 5, each=21)

df$year <- rep(c("Year 1", "Year 2", "Year 3", "Year 4", "Year 5" ), 1, each=252)

#solution:
month_lab <- rep(unique(df$month), length(unique(df$year)))

year_lab <- unique(df$year)

df %>%
  as.data.frame() %>%
  rename(price = 1) %>% 
  mutate(rnames = rownames(.)) %>% 
  ggplot(aes(x = as.numeric(rnames), y = price, 
             group = year)) +
  geom_line() +
  labs(title = "Stock Price Chart", y = "Price", x = "date") +
  scale_x_continuous(breaks = seq(1, 1260, by = 21), 
                     labels = month_lab, expand = c(0,0)) +
  facet_grid(~year, space="free_x", scales="free_x", switch="x") +
  theme(strip.placement = "outside",
        strip.background = element_rect(fill=NA,colour="grey50"),
        panel.spacing=unit(0,"cm"))

reprex package (v0.3.0)

于 2019-05-28 创建