Question

我想从数据框中删除具有重叠开始日期和结束日期的产品，以避免在后续步骤中出现重复。

示例数据：

library(dplyr)

d <-
  bind_rows(
    data.frame(product = 1, 
               start_date = as.Date("2016-01-01"), 
               end_date = as.Date("2016-01-10"), 
               stringsAsFactors = FALSE),
    data.frame(product = 1, 
               start_date = as.Date("2016-01-02"), 
               end_date = as.Date("2016-01-04"), 
               stringsAsFactors = FALSE),
    data.frame(product = 1, 
               start_date = as.Date("2016-01-05"), 
               end_date = as.Date("2016-06-09"), 
               stringsAsFactors = FALSE),
    data.frame(product = 2, 
               start_date = as.Date("2016-01-03"), 
               end_date = as.Date("2016-01-07"), 
               stringsAsFactors = FALSE)  
    )

  product start_date   end_date
1       1 2016-01-01 2016-01-10
2       1 2016-01-02 2016-01-04
3       1 2016-01-05 2016-06-09
4       2 2016-01-03 2016-01-07

从这个例子中我想删除第2行和第3行，因为重叠。

我使用滞后函数来删除彼此相邻的重叠：

d_cleaned <-
  d %>%
  arrange(product, start_date, end_date) %>%
  mutate(overlapping = product == lag(product) & start_date <= lag(end_date) & end_date >= lag(start_date)) %>% # define overlaps
  mutate(overlapping = ifelse(is.na(overlapping), FALSE, overlapping)) %>% # dont delete the first row
  filter(overlapping == FALSE) %>% # remove overlaps
  select(-overlapping)

  product start_date   end_date
1       1 2016-01-01 2016-01-10
2       1 2016-01-05 2016-06-09
3       2 2016-01-03 2016-01-07

从上面可以看出，此步骤消除了连续行的重叠，但不是全部。

我可以通过循环来解决这个问题，但是我希望有人能够建议一个非循环解决方案，因为数据帧非常大并且每个步骤都需要一段时间。

Answer 1

我相信以下内容可行

d <- cbind(ID=1:nrow(d),d)
d_cleaned <- d[rep(1:nrow(d), times=nrow(d)),] %>%         ## 1
  setNames(.,paste0(names(.),"_other")) %>%                ## 2
  bind_cols(d[rep(1:nrow(d), each=nrow(d)),], .) %>%       ## 3
  arrange(product,start_date,end_date) %>%                 ## 4
  filter(product == product_other) %>%                     ## 5
  mutate(overlapping = ID_other < ID &
           start_date <= end_date_other & 
           end_date >= start_date_other) %>%               ## 6
  group_by(ID) %>%
  filter(all(overlapping==FALSE)) %>%                      ## 7
  ungroup() %>%
  select(product,start_date,end_date) %>%
  distinct())

print(d_cleaned)
### A tibble: 2 x 3
##  product start_date   end_date
##    <dbl>     <date>     <date>
##1       1 2016-01-01 2016-01-10
##2       2 2016-01-03 2016-01-07

首先，添加一列ID s，以便稍后将数据框的行标识为group_by，以确定是否与任何其他行重叠。关键是能够在重叠测试中考虑具有相同product的所有不同行对。上面的代码通过扩展 outer-join 中的数据来实现这一点。具体地，

重复d nrow(d)次
通过向其添加_other来更改列的名称，以便可以在重叠测试中与原始列名称分开引用它们
复制d nrow(d)次的每一行，并将（2）的结果作为新列追加

（3）的结果具有枚举原始数据帧中所有行对的行。然后：

按照您的方式对它们进行排序。
仅考虑product匹配的对。先做这个，尽量减少不需要的比较
进行重叠测试。这里仅对原始数据帧中的先前行进行比较。这具有考虑所有滞后并保留行本身（即，所有行与其自身重叠）的效果
按ID分组（原始数据框中的每一行）并保留所有 overlapping为FALSE

此时，结果仅包含原始数据框中的非重叠行。但是，存在所有这些额外的列，并且存在重复，其中多行与行重叠。其余的代码清理了这一点。

我已经使用以下数据对其进行了测试（增加了您的数据以添加更多测试条件，但远非详尽无遗）：

d <- structure(list(product = c(1, 1, 1, 1, 1, 2, 2), start_date = structure(c(16801, 
16802, 16805, 16811, 16962, 16803, 16806), class = "Date"), end_date = structure(c(16810, 
16804, 16961, 16961, 16964, 16807, 16810), class = "Date")), .Names = c("product", 
"start_date", "end_date"), row.names = c(NA, -7L), class = "data.frame")

并得到以下结果：

# A tibble: 3 x 3
  product start_date   end_date
<dbl>     <date>     <date>
1       1 2016-01-01 2016-01-10
2       1 2016-06-10 2016-06-12
3       2 2016-01-03 2016-01-07

希望这有帮助。

Answer 2

使用当前开发版non-equi中的data.table联接，v1.9.7：

require(data.table) # v1.9.7+
setDT(d) # convert 'd' to a data.table by reference
idx = d[d, on=.(product, end_date>=start_date, start_date<=end_date), mult="first", which=TRUE]
d[idx == seq_len(.N)] # .N contains the number of rows = nrow(d)
#    product start_date   end_date
# 1:       1 2016-01-01 2016-01-10
# 2:       1 2016-06-10 2016-06-12
# 3:       2 2016-01-03 2016-01-07

对于d中的每一行（方括号内的一行），我们发现任何与d（在外部）的重叠，即自我-join，基于提供给on参数的条件，我们提取第一个重叠的索引（因为which=TRUE和{{ 1}}）。

当且仅当第一次重叠与自身重叠时，我们才会返回它们。我们丢弃所有其他间隔。

要安装devel版本，请参阅安装说明here。

以下是稍微多一行的基准（数据绝不是大）：

mult="first"

如何从R

2 个答案: