用ggplot绘制时间标签覆盖范围

Question

我正在尝试重现一个图表，该图表可视化一组电子标签的时间跨度，但收效甚微。我附上了一个简单的例子，说明我想要制作的那种情节以及制作该情节的数据。使用ggplot生成此图的任何帮助都会非常有用。

请注意，在我不关心年份的情节中，我只想想象标签记录数据的日期和月份。另请注意，对于像4120这样的标签，这些标签在今年晚些时候（9月）推出并继续生成数据，直到下一年（4月）开始，该酒吧一直持续到年底，然后又有另一个酒吧从1月份开始，可视化标签记录的其余部分。

dat <- structure(list(Tag_Num = c(44386L, 44387L, 44388L, 44390L, 52236L, 
52237L, 52238L, 60639L, 60641L, 61921L, 61925L, 61932L, 61936L, 
61938L, 61940L, 61957L, 63975L, 63977L, 87565L, 100949L), Deploy = structure(c(1L, 
3L, 2L, 9L, 5L, 7L, 14L, 6L, 4L, 13L, 15L, 20L, 10L, 12L, 8L, 
19L, 16L, 11L, 18L, 17L), .Label = c("5/4/2004", "5/5/2004", 
"5/6/2004", "6/22/2011", "6/24/2005", "6/24/2011", "6/26/2005", 
"6/30/2006", "7/3/2004", "9/1/2006", "9/10/2007", "9/11/2007", 
"9/12/2006", "9/15/2007", "9/21/2006", "9/22/2006", "9/24/2010", 
"9/6/2008", "9/7/2006", "9/9/2006"), class = "factor"), Recover = structure(c(14L, 
14L, 14L, 2L, 18L, 17L, 3L, 16L, 15L, 7L, 4L, 12L, 9L, 6L, 13L, 
8L, 5L, 11L, 1L, 10L), .Label = c("12/20/2008", "12/31/2004", 
"3/14/2008", "3/21/2007", "4/18/2007", "5/12/2008", "5/15/2007", 
"5/16/2007", "5/21/2007", "5/22/2011", "5/8/2008", "5/9/2007", 
"7/26/2006", "9/10/2004", "9/20/2011", "9/22/2011", "9/25/2005", 
"9/8/2005"), class = "factor")), .Names = c("Tag_Num", "Deploy", 
"Recover"), class = "data.frame", row.names = c(NA, -20L))

该图不再与上述数据集匹配，但仍然提供了我想要完成的示例。

Answer 1

我找到了一个解决方案，虽然我最终依靠Julian日期来实现这个目标。我非常依赖lubridate，dplyr和ggplot2包。

我花了很长时间弄清楚数据集的外观。如果您只有这五个点，则可以轻松地为4120创建第二行。以下是使用do中的dplyr对整个数据集执行此操作的方法。

require(dplyr)
require(lubridate)

dat2 = dat %>%
    group_by(Tag_Num) %>%
    do(if(year(mdy(.$Deploy)) - year(mdy(.$Recover)) != 0) {
        data.frame(Deploy = c(as.character(.$Deploy), paste("1/1", year(mdy(.$Recover)), sep = "/")), 
                  Recover = c(paste("12/31", year(mdy(.$Deploy)), sep = "/"), as.character(.$Recover))) }
        else { data.frame(Deploy = .$Deploy, Recover = .$Recover) } )

现在数据集看起来像：

  Tag_Num    Deploy    Recover
1    4001  1/1/2014   9/1/2014
2    4120  9/1/2013 12/31/2013
3    4120  1/1/2014  4/20/2014
4    4356  1/1/2011  6/29/2011
5    4665 3/15/2010 10/17/2010

我转换为Julian Day Deploy并恢复实际绘图的日期。我也把部署年份放在了一起，所以你可以在技术上按照年份的颜色做一些事情。

dat2 = dat2 %>% ungroup %>% 
    mutate(year = year(mdy(Deploy)), JDeploy = yday(mdy(Deploy)), 
          JRecover = yday(mdy(Recover)), Tag_Num = factor(Tag_Num))

  Tag_Num    Deploy    Recover year JDeploy JRecover
1    4001  1/1/2014   9/1/2014 2014       1      244
2    4120  9/1/2013 12/31/2013 2013     244      365
3    4120  1/1/2014  4/20/2014 2014       1      110
4    4356  1/1/2011  6/29/2011 2011       1      180
5    4665 3/15/2010 10/17/2010 2010      74      290

为了在x轴而不是朱利安日放几个月，我想出了每个月中旬的近似朱利安日作为轴断。这对我来说似乎有些苛刻，但不确定如何定义休息时间。

# Make breaks in Julian Day that will be equivalent to essentially midmonth?
xbreaks = yday(paste(2013, 1:12, c(15, 14, rep(15, 10)), sep = "-"))
# If want labels at start of each month rather than midmonth
xbreaks2 = yday(paste(2013, 1:12, 1, sep = "-"))

然后用ggplot2绘图。这依赖于使用因素as.numeric上的Tag_Num用于geom_segment。然后使用Tag_Num的级别设置y轴断裂标签。您可以更改y轴的顺序，更改数据集中Tag_Num级别的顺序。

修改

使用更多标签时，y轴上的数字中断默认情况下不再代表每个唯一标记（在OP中使用更新的数据集）。您可以通过在breaks中设置scale_y_continuous来解决此问题。

require(ggplot2)

ggplot(dat2, aes(x = JDeploy, xend = JRecover, y = as.numeric(Tag_Num), yend = as.numeric(Tag_Num))) +
    geom_segment(size = 5) +
    scale_y_continuous(breaks = unique(as.numeric(dat2$Tag_Num)), labels = paste("Tag", levels(dat2$Tag_Num))) + 
    ylab(NULL) + 
    xlab(NULL) +
    scale_x_continuous(breaks = xbreaks2, labels = format(ISOdate(2004,1:12,1),"%b"))