使用 R 中的 Vistime 包将时间线合并为一个时间线

Merging Timelines Together to Make One Timeline Using Vistime Package in R

尝试通过 vistime 创建时间线时,日期重叠会产生更像甘特图的图形,这是不受欢迎的。我希望有一个连续的时间表。

下面我展示了当前的问题和期望的结果。

当前输出:

library(vistime)
syst2 <- data.frame(Position = c(0,0,rep(c( 1,0), 3)),
        Name = rep(c("SYS2", "SYS2","SYS4","SYS4"), each=2),
        start = c("2018-10-01","2018-10-11","2018-11-26","2018-12-06","2018-10-01","2018-10-24","2018-11-23","2018-12-05"),
        end = c("2018-10-16","2018-11-26","2018-12-06","2018-12-31","2018-10-24","2018-11-23","2018-12-05","2018-12-31"),
        color = c('#FF0000','#FF0000',rep(c("#008000",'#FF0000'), 3)),
        fontcolor = c('#FF0000','#FF0000',rep(c("#008000",'#FF0000'), 3)))


vistime(syst2, events = "Position", groups = "Name")

期望输出: 如何合并相似职位(例如 0 或 1)的重叠时间段的日期范围?

syst2 <- data.frame(Position = c(rep(c( 0,1), 3),0),
        Name = c(rep(c("SYS2"), each=3),rep(c("SYS4"), each=4)),
        start = c("2018-10-01","2018-11-26","2018-12-06","2018-10-01","2018-10-24","2018-11-23","2018-12-05"),
        end = c("2018-11-26","2018-12-06","2018-12-31","2018-10-24","2018-11-23","2018-12-05","2018-12-31"),
        color = c(rep(c('#FF0000',"#008000"), 3),'#FF0000'),
        fontcolor = c(rep(c('#FF0000',"#008000"), 3),'#FF0000'))


vistime(syst2, events = "Position", groups = "Name")

这可以通过两种方式实现:

1.) 绘制前修正数据

syst2 <- data.frame(Position = c(0,0,rep(c( 1,0), 3)),
                    Name = rep(c("SYS2", "SYS2","SYS4","SYS4"), each=2),
                    start = c("2018-10-01","2018-10-11","2018-11-26","2018-12-06","2018-10-01","2018-10-24","2018-11-23","2018-12-05"),
                    end = c("2018-10-16","2018-11-26","2018-12-06","2018-12-31","2018-10-24","2018-11-23","2018-12-05","2018-12-31"),
                    color = c('#FF0000','#FF0000',rep(c("#008000",'#FF0000'), 3)))

# make Dates comparable
syst2$start <- as.Date(as.character(syst2$start))
syst2$end <- as.Date(as.character(syst2$end))

# check if ranges of the same type overlap, extend first range if it does
syst2 <- syst2[order(syst2$Name, syst2$start),]
for(row in 1:(nrow(syst2) - 1)) if(syst2$Name[row] == syst2$Name[row+1] & syst2$end[row] > syst2$start[row+1]){
  syst2$end[row] <- syst2$end[row+1]
  syst2$start[row+1] <- syst2$start[row]
}

# kill the duplicates
syst2 <- unique(syst2)

# draw it
vistime(syst2, events = "Position", groups = "Name")

2。生成后操作生成的vistime对象

# repeating your setup
syst2 <- data.frame(Position = c(0,0,rep(c( 1,0), 3)),
                Name = rep(c("SYS2", "SYS2","SYS4","SYS4"), each=2),
                start = c("2018-10-01","2018-10-11","2018-11-26","2018-12-06","2018-10-01","2018-10-24","2018-11-23","2018-12-05"),
                end = c("2018-10-16","2018-11-26","2018-12-06","2018-12-31","2018-10-24","2018-11-23","2018-12-05","2018-12-31"),
                color = c('#FF0000','#FF0000',rep(c("#008000",'#FF0000'), 3)))

 p <- vistime(syst2, events = "Position", groups = "Name", showLabels = FALSE)

# looping through all data, if any drawn data has y coordinates "2", change it to 1
p$x$data <- lapply(p$x$data, function(l){
    if(all(l$y == 2)){
        l$y <- rep(1, length(l$y)) # lines have 2 y coordinates
        return(l)
    }else{
        return(l)
    }
})

p

我用的vistime版本0.7.0.9000,可以通过devtools::install_github("shosaco/vistime").

获取

只是一个额外的、独立的评论:您似乎不希望显示标签。为此,您不需要将 fontcolor 列设置为等于 color 列。为此还有一个额外的参数:showLabels = FALSE.