可能微不足道,但我很难把它弄好。
鉴于start
中的end
和A
日期,以及日期范围之间的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)
,并且在某些时间间隔内缺少日期范围。
谢谢。
答案 0 :(得分: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-04-24。