R使用facet_wrap绘制具有时间间隔的时间序列答案

【问题标题】：R Plotting time-series with time-gaps using facet_wrapR使用facet_wrap绘制具有时间间隔的时间序列
【发布时间】：2020-06-07 17:09:46
【问题描述】：

我想用 2 个不同的数据帧绘制时间序列。问题是数据中存在很大的时间间隔。我想消除差距并获得 4 个小地块，而不是 1 个有巨大差距的大地块。我知道 facet_wrap 可以完成这项工作，但我没有让它在我的情节中工作。我不能只是手动消除间隙，我需要一些自动的东西。

library(ggplot2)
theme_set(theme_gray()) 
p1 = ggplot() + 
  geom_bar(data = Test1, aes(x = Test1$Date, y = Test1$G), stat="identity", color = "red") +
  geom_bar(data = Test2, aes(x = Test2$Date, y = Test2$G), stat="identity", color = "grey") +
  scale_x_date(date_labels ="%m/%y",date_breaks  = "1 month")

p1

Test1:

structure(list(Date = structure(c(17186, 17187, 17188, 17189, 
17436, 17437, 17438, 17453, 17454, 17455, 17456, 17457, 17458, 
17541, 17542, 17543, 17569, 17570, 17571, 17572), class = "Date"), 
    G = c(1L, 8L, 2L, 13L, 3L, 8L, 4L, 5L, 3L, 4L, 9L, 7L, 11L, 
    7L, 6L, 7L, 4L, 7L, 5L, 4L)), row.names = c("20", "21", "22", 
"23", "270", "271", "272", "287", "288", "289", "290", "291", 
"292", "375", "376", "377", "403", "404", "405", "406"), class = "data.frame", .Names = c("Date", 
"G"))

Test2:

structure(list(Date = structure(c(17167, 17168, 17169, 17170, 
17171, 17172, 17173, 17174, 17175, 17176, 17177, 17178, 17179, 
17180, 17181, 17182, 17183, 17184, 17185, 17190, 17191, 17192, 
17193, 17194, 17195, 17196, 17197, 17198, 17199, 17200, 17201, 
17202, 17203, 17204, 17205, 17206, 17207, 17208, 17209, 17210, 
17211, 17212, 17213, 17214, 17215, 17216, 17217, 17218, 17219, 
17220, 17221, 17222, 17223, 17224, 17225, 17410, 17411, 17412, 
17413, 17414, 17415, 17416, 17417, 17418, 17419, 17420, 17421, 
17422, 17423, 17424, 17425, 17426, 17427, 17428, 17429, 17430, 
17431, 17432, 17433, 17434, 17435, 17439, 17440, 17441, 17442, 
17443, 17444, 17445, 17446, 17447, 17448, 17449, 17450, 17451, 
17452, 17459, 17460, 17461, 17462, 17463, 17464, 17465, 17466, 
17467, 17468, 17469, 17470, 17532, 17533, 17534, 17535, 17536, 
17537, 17538, 17539, 17540, 17544, 17545, 17546, 17547, 17548, 
17549, 17550, 17551, 17552, 17553, 17554, 17555, 17556, 17557, 
17558, 17559, 17560, 17561, 17562, 17563, 17564, 17565, 17566, 
17567, 17568, 17573, 17574, 17575, 17576, 17577, 17578, 17579, 
17580, 17581, 17582, 17583, 17584, 17585, 17586, 17587, 17588, 
17589, 17590, 17775, 17776, 17777, 17778, 17779, 17780, 17781, 
17782, 17783, 17784, 17785, 17786, 17787, 17788, 17789, 17790, 
17791, 17792, 17793, 17794, 17795, 17796, 17797, 17798, 17799, 
17800, 17801, 17802, 17803, 17804, 17805, 17806, 17807, 17808, 
17809, 17810, 17811, 17812, 17813, 17814, 17815, 17816, 17817, 
17818, 17819, 17820, 17821, 17822, 17823, 17824, 17825, 17826, 
17827, 17828, 17829, 17830, 17831, 17832, 17833, 17834, 17835
), class = "Date"), G = c(3L, 9L, 7L, 2L, 3L, 4L, 4L, 5L, 2L, 
6L, 6L, 8L, 7L, 1L, 2L, 9L, 3L, 7L, 10L, 11L, 6L, 3L, 4L, 4L, 
2L, 9L, 3L, 3L, 2L, 6L, 1L, 3L, 7L, 5L, 2L, 6L, 7L, 6L, 2L, 2L, 
7L, 2L, 3L, 4L, 6L, 6L, 4L, 6L, 3L, 2L, 6L, 2L, 3L, 7L, 5L, 7L, 
4L, 5L, 4L, 2L, 4L, 7L, 4L, 4L, 7L, 6L, 4L, 1L, 8L, 4L, 3L, 4L, 
6L, 6L, 5L, 5L, 6L, 1L, 3L, 8L, 7L, 6L, 2L, 4L, 5L, 8L, 4L, 4L, 
2L, 5L, 7L, 7L, 4L, 5L, 5L, 5L, 4L, 1L, 13L, 3L, 6L, 8L, 3L, 
3L, 2L, 2L, 3L, 5L, 4L, 5L, 3L, 5L, 6L, 2L, 5L, 7L, 2L, 3L, 6L, 
7L, 2L, 5L, 6L, 2L, 5L, 6L, 5L, 5L, 8L, 3L, 3L, 4L, 5L, 8L, 10L, 
6L, 5L, 2L, 6L, 4L, 3L, 3L, 2L, 5L, 3L, 4L, 5L, 7L, 2L, 5L, 6L, 
7L, 6L, 5L, 4L, 4L, 7L, 2L, 5L, 3L, 3L, 6L, 6L, 3L, 5L, 4L, 5L, 
3L, 9L, 3L, 3L, 2L, 5L, 3L, 3L, 9L, 6L, 1L, 3L, 6L, 6L, 3L, 8L, 
9L, 4L, 3L, 5L, 6L, 2L, 10L, 4L, 7L, 4L, 3L, 5L, 3L, 4L, 4L, 
6L, 0L, 3L, 5L, 1L, 6L, 3L, 5L, 4L, 1L, 1L, 5L, 5L, 1L, 3L, 4L, 
11L, 3L, 1L, 7L, 1L, 6L)), row.names = c("1", "2", "3", "4", 
"5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", 
"16", "17", "18", "19", "24", "25", "26", "27", "28", "29", "30", 
"31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", 
"42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", 
"53", "54", "55", "56", "57", "58", "59", "244", "245", "246", 
"247", "248", "249", "250", "251", "252", "253", "254", "255", 
"256", "257", "258", "259", "260", "261", "262", "263", "264", 
"265", "266", "267", "268", "269", "273", "274", "275", "276", 
"277", "278", "279", "280", "281", "282", "283", "284", "285", 
"286", "293", "294", "295", "296", "297", "298", "299", "300", 
"301", "302", "303", "304", "366", "367", "368", "369", "370", 
"371", "372", "373", "374", "378", "379", "380", "381", "382", 
"383", "384", "385", "386", "387", "388", "389", "390", "391", 
"392", "393", "394", "395", "396", "397", "398", "399", "400", 
"401", "402", "407", "408", "409", "410", "411", "412", "413", 
"414", "415", "416", "417", "418", "419", "420", "421", "422", 
"423", "424", "609", "610", "611", "612", "613", "614", "615", 
"616", "617", "618", "619", "620", "621", "622", "623", "624", 
"625", "626", "627", "628", "629", "630", "631", "632", "633", 
"634", "635", "636", "637", "638", "639", "640", "641", "642", 
"643", "644", "645", "646", "647", "648", "649", "650", "651", 
"652", "653", "654", "655", "656", "657", "658", "659", "660", 
"661", "662", "663", "664", "665", "666", "667", "668", "669"
), class = "data.frame", .Names = c("Date", "G"))

【问题讨论】：

DF1 == Test1 和 DF2 == Test2?
是的，很抱歉我没有说清楚。
Spock 先生，其中一个（或两个）答案是否解决/解决了您的问题？

标签： r ggplot2 time-series

【解决方案1】：

通常最好不要在aes 中使用$ 索引；当您使用data= 时尤其如此，更惯用的方式是geom_bar(data = Test1, aes(Date, G), ...)。
我们可以使用cumsum(diff(Date) > .) 按间隙获取组，但尚不清楚间隙应该在哪里。例如，
```
table(diff(Test1$Date))
#   1  15  26  83 247 
#  15   1   1   1   1 
table(diff(Test2$Date))
#   1   4   5   7  62 185 
# 211   2   2   1   1   2 
```
您说“4 个方面”，但在两个数据集中都没有提供 4 个方面的间隙宽度。我将使用Test2 和10 的间隙宽度，但这意味着Test1 只会填充四个方面中的三个。

由于我们正在分面，我们需要向两个数据集添加一些分组变量。

mindates <- by(Test2$Date, cumsum(c(TRUE, diff(Test2$Date) > 10)), 
               min, simplify = FALSE)
mindates <- as.Date(unlist(mindates))
mindates
#            1            2            3            4 
# "2017-01-01" "2017-09-01" "2018-01-01" "2018-09-01" 
Test1$grp <- findInterval(Test1$Date, c(unlist(mindates), Inf), left.open = FALSE)
Test2$grp <- findInterval(Test2$Date, c(unlist(mindates), Inf), left.open = FALSE)ggplot() +
  theme_gray() +
  geom_bar(data = Test1, aes(x = Date, y = G), stat="identity", color = "red") +
  geom_bar(data = Test2, aes(x = Date, y = G), stat="identity", color = "grey") +
  scale_x_date(date_labels ="%m/%y",date_breaks  = "1 month") +
  facet_wrap(~ grp, scales = "free_x")

【讨论】：

【解决方案2】：

这是一个使用层次聚类来找到好的断点的解决方案。

library(dplyr)
library(ggplot2)

df <- bind_rows(df1, df2, .id = "df_group")

df_clust <- df %>%
  mutate(clust = hclust(dist(Date)) %>%
           cutree(k = 4))

ggplot(data = df_clust, aes(x = Date, y = G, color = as.factor(clust))) +
  geom_point()

这是聚类的结果：

现在我们可以继续进行所需的情节：

theme_set(theme_gray())
ggplot(data = df_clust, aes(x = Date, y = G, fill = df_group)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values = c("1" = "red", "2" = "gray")) +
  facet_grid(. ~ clust, scales = "free")

^{由reprex package (v0.3.0) 于 2020-06-07 创建}

您可能想要稍微调整一下日期轴以使其看起来更漂亮。

【讨论】：

很好地使用df_group。