datetime-确定多个日期时间范围是否在R中相互重叠

Question

嗨，朋友们，我很难找到多个日期时间范围是否相互重叠，如果是，则它们重叠的时间段。我已经参考了以下链接 确定两个日期范围是否重叠 和 算法 以检测重叠的时间段等等。

不知道这是否正确，我有n=3的示例解释。

假设我有“n”开关 sw1，sw2

Switches,State,Intime,Outtime

sw3,1,9:00:00,10:40:00
sw2,1,9:30:00,10:15:00
sw1,1,10:00:00,11:00:00
sw2,1,10:20:00,10:30:00

我遇到过这种可能性。可能还有更多。仍在寻找其他的。这里常见的时间段是从10:00到10:15即15分钟，10:20到10:30即10分钟。这些开关打开（“1”）的总时间段是25分钟。

                 10:00                           11:00
              sw1 |-----------------------------------|
       9:30       10:15   10:20     10:30
     sw2 |-------------|      |-------|
 9:00                                     10:40 
sw3 |----------------------------------------| 

为n个重叠的开关概括此日期时间是一项困难的任务。我仍在努力，所以欢迎任何建议或修改。非常感谢。

Answer 1

一种html" target="_blank">方法是：

1. 计算每个交换机的Intime和Outtime之间的唯一分钟/秒。E、 g.如果开关在9:00打开并在9:02关闭，则其在9:00和9:01之间打开的唯一分钟数。
2. 统计所有交换机上每一唯一分钟/秒出现的次数
3. 如果任何一分钟/秒发生的次数与开关的次数一样多（即，在您的情况下为三次），则所有开关必须在该分钟/秒内打开

使用该逻辑，这是一个潜在的解决方案（数据存储在数据框 x 中）：

# Function to convert string to time.
asTime <- function (tm) as.POSIXlt(tm, format = '%H:%M:%S')

# Calculate unique minutes between Intimes and Outtimes.
minSpan <- function (start, end) seq(asTime(start), asTime(end) - 1, 'min')

# Calculate the time span in minutes for each row.
spans <- mapply(minSpan, x$Intime, x$Outtime)

# Count how many times each minute appears.
counts <- table(do.call(c, spans))

# Total number of switches.
switches <- length(unique(x$Switches))

# Count minutes where all switches have been on.
length(counts[counts == switches])

这将使你精确到一分钟，因为这似乎是你在你的问题中显示的。尽管您可以通过在< code>minSpan()函数中将< code>'min'更改为< code>'sec'来轻松地将其更改为秒。

在< code>minSpan()中，我从< code>Outtime中减去一分钟:

minSpan <- function (start, end) seq(asTime(start), asTime(end) - 1, 'min')

这是因为如果你要计算 10：00 和 10：02 之间的分钟，seq（） 将返回三分钟，10：00、10：01、10：02。但实际上，开关在 10：02 关闭，所以你真的想要从 10：00 到 10：01 的跨度。

无论如何，这个解决方案似乎对你给出的小例子有效。根据你的数据有多大，我认为这足够慢，但这可能不是问题。

Answer 2

1）基于样本数据，我们假设数据的形式为hh： mm： 00其中hh

读入测试数据。创建两个将hh:mm:00形式的字符串转换为分钟数的函数，以及一个将分钟数转换为chron "times"对象的函数。为给出< code >间隔列表的每一行数据创建分钟序列。并集对应于相同开关的序列，给出列表< code>Intervals.u，然后相交该列表的组件，给出序列< code>Intersection。计算< code >交集中的游程，< code>r，以给出一组起点和终点。最后，计算分钟数，并将其转换为持续时间。(分钟数和持续时间仅取决于< code>r和< code>Intersection，因此如果不需要< code>intervals.df,我们可以跳过以##结尾的行。)

# test data
Lines <- "Switches,State,Intime,Outtime
sw3,1,9:00:00,10:40:00
sw2,1,9:30:00,10:15:00
sw1,1,10:00:00,11:00:00
sw2,1,10:20:00,10:30:00"
DF <- read.csv(text = Lines, as.is = TRUE)

library(chron)

to.num <- function(x) floor(as.numeric(times(x)) * 24 * 60 + 1e-6)
to.times <- function(x) times(x / (24 * 60))

Seq <- function(r) seq(to.num(DF$Intime[r]), to.num(DF$Outtime[r]))    
Intervals <- lapply(1:nrow(DF), Seq)
Intervals.u <- lapply(split(Intervals, DF$Switches), 
     function(L) Reduce(union, L))
Intersection <- Reduce(intersect, Intervals.u)

r <- rle(c(FALSE, diff(Intersection) == 1))

i.ends <- cumsum(r$lengths)[r$values] ##
ends <- to.times(Intersection[i.ends]) ##
starts <- ends - to.times(r$lengths[r$values]) ##
intervals.df <- data.frame(start = starts, end = ends); intervals.df ##
##         start      end
##    1 10:00:00 10:15:00
##    2 10:20:00 10:30:00

mins <- length(Intersection) - sum(r$values); mins
## [1] 25
duration <- to.times(mins); duration
## [1] 00:25:00

2）关于速度的评论，我们可以改用IRanges包，它可以有效地编码范围，也可以略微减少代码大小：

library(IRanges)
Intervals <- IRanges(to.num(DF$Intime), to.num(DF$Outtime))
Intersection <- Reduce(intersect, split(Intervals, DF$Switches))

intervals.df <- data.frame(start = to.times(start(Intersection)), 
                           end = to.times(end(Intersection)))
intervals.df
##      start      end
## 1 10:00:00 10:15:00
## 2 10:20:00 10:30:00

mins <- sum(width(Intersection) - 1); mins
## [1] 25
duration <- to.times(mins); duration
## [1] 00:25:00

更新了一些修正和更好的变量名。进一步的改进。增加了(2)。