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

时间:2018-04-24 18:01:56

标签: r date time-series

可能微不足道,但我很难把它弄好。

鉴于start中的endA日期,以及日期范围之间的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")和关于给定start的{​​{1}}和end日期的阴影区域。

没有记录值的日期范围应为duration

我如何使用任何包实现这个?

首先想到的是创建一个连续的日期:

NA.
然后做绘图?一个类似的问题是here,但在这里我打算对日期范围进行着色。我的数据来自library(dplyr) data_with_missing_times <- full_join(ts,A) ,并且在某些时间间隔内缺少日期范围。

谢谢。

sample plot to reproduce

1 个答案:

答案 0 :(得分:1)

我不确定你想要绘制什么,但这里有一些可以解决问题的方法。奇怪的是,你有因子形式而不是列表列的区域,因为这会强制separate_rowsfilter而不是简单的unnest。这里的主要内容是为每个组添加一个额外的行,以便持续时间1具有两个日期值,然后根据这些分组添加正确的日期。这样我们就可以使用geom_ribbongeom_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-04-24。