绘制缺少日期范围 R 的时间序列

Question

对我来说可能微不足道但很难做到。

鉴于A中的start和end日期，以及日期范围之间的duration in months：

A=
structure(list(start..yyyy.mm. = c(197901L, 197901L, 197901L, 
    197901L, 197901L), X.yyyy.mm. = c(197901L, 197904L, 197908L, 
    197902L, 197902L), duration = c(1L, 4L, 8L, 2L, 2L), area..km.2. = structure(c(1L, 
    2L, 4L, 3L, 5L), .Label = c("46952.85", "c(125267.7, 72379.43, 72468.91, 13200.26)", 
    "c(19814.74, 39570.96)", "c(26513.05, 26513.05, 26513.05, 26513.05, 26513.05, 19898.57, 26513.05, 26513.05)", 
    "c(52291.77, 52291.77)"), class = "factor")), .Names = c("start..yyyy.mm.", 
    "X.yyyy.mm.", "duration", "area..km.2."), class = "data.frame", row.names = c(NA, 
    -5L))

我想制作类似于下图所示的内容（忽略直方图）。每个duration 的颜色不同。在A 中，第一个area 值对应于日期范围等中的first month。

如您所见，A 中的日期不是连续的。因此，我们的意图是创建一个连续的日期轴，例如 ts <- seq(as.Date("1910-01-01"), as.Date("2015-12-31"), by="month") 和相对于给定 duration 的 start 和 enddates 的阴影区域。

记录的值不应包含NA.的日期范围

如何使用任何包来实现这是 R？

想到的第一个想法是创建一个连续日期：

library(dplyr)
data_with_missing_times <- full_join(ts,A)

然后进行绘图？一个类似的问题是here 但在这里我打算遮蔽日期范围。我的数据来自1910 - 2015，在某些时间间隔内缺少日期范围。

谢谢。

Answer 1

我不确定你想要绘制什么，但这里有一些可以解决问题的方法。奇怪的是，您拥有因子形式的区域而不是列表列，因为这会强制 separate_rows 和 filter 而不是简单的 unnest。这里的主要内容是为每个组添加一个额外的行，以便持续时间 1 具有两个日期值，然后根据这些分组添加正确的日期。这使我们可以使用geom_ribbon 或geom_area 绘制重叠日期，无论您选择什么。

编辑：如果您仔细研究这种方法，它的作用是避免在时间序列中为每个月创建行，而只在有区域要绘制的地方创建观察。如果您想扩展 x 轴的范围，您可以简单地调用 scale_x_date 并更改范围，但它应该会自动缩放到数据所在的位置。还更改了输入数据，使其不重叠，并更改了功能区图以匹配。

library(tidyverse)
A <- structure(list(start..yyyy.mm. = c(197901L, 197901L, 197901L,197901L, 197901L), X.yyyy.mm. = c(197901L, 197904L, 197908L,197902L, 197902L), duration = c(1L, 4L, 8L, 2L, 2L), area..km.2. = structure(c(1L,2L, 4L, 3L, 5L), .Label = c("46952.85", "c(125267.7, 72379.43, 72468.91, 13200.26)","c(19814.74, 39570.96)", "c(26513.05, 26513.05, 26513.05, 26513.05, 26513.05, 19898.57, 26513.05, 26513.05)","c(52291.77, 52291.77)"), class = "factor")), .Names = c("start..yyyy.mm.","X.yyyy.mm.", "duration", "area..km.2."), class = "data.frame", row.names = c(NA,-5L))

tbl <- A %>%
  mutate(start = seq.Date(as.Date("1979-01-01"), by = "year", length.out = 5)) %>%
  select(start, duration, area = area..km.2.) %>%
  rowid_to_column() %>%
  separate_rows(area) %>%
  filter(!area %in% c("c", ""))

indices <- seq(nrow(tbl)) %>%
  split(group_indices(tbl, rowid)) %>%
  map(~ c(.x, NA)) %>%
  unlist()

tbl <- tbl[indices, ] %>%
  fill(rowid, start, duration, area) %>%
  group_by(rowid) %>%
  mutate(
    date = seq.Date(
      from = first(start),
      by = "month",
      length.out = first(duration) + 1
    ),
    area = as.numeric(area)
  ) %>%
  ungroup()

ggplot(tbl) +
  geom_ribbon(aes(x = date, fill = factor(rowid), ymax = 1, ymin = 0))

ggplot(tbl) +
  geom_area(
    mapping = aes(x = date, y = area, fill = factor(rowid)),
    alpha = 0.3,
    position = "identity"
    ) +
  scale_x_date(limits = c(as.Date("1979-01-01"), Sys.Date()))

由reprex package (v0.2.0) 于 2018 年 4 月 24 日创建。