R计数行，直到按组达到条件答案

【问题标题】：R count rows until a condition is reached by groupR计数行，直到按组达到条件
【发布时间】：2016-07-19 23:33:37
【问题描述】：

我正在尝试计算行数，直到在分组数据框中达到某个条件。我试图调整解决方案 here 但这似乎不适用于团体。

样本数据：

grp <- c(rep(1:2, each = 5), 3)
fromdate <- as.Date(c("2010-06-01", "2012-02-01", "2013-02-01", "2013-02-01", "2015-10-01", "2011-02-01", "2011-03-01", "2013-04-01", "2013-06-01", "2013-10-01", "2012-02-01"), origin = "1970-01-01")
todate <- as.Date(c("2016-12-31", "2013-01-31", "2015-10-31", "2015-12-31", "2016-01-31", "2013-02-28", "2013-02-28", "2013-09-30", "2016-12-31", "2017-01-31", "2014-01-31"), origin = "1970-01-01")
df <- data.frame(grp, fromdate, todate)

我的最终目标是每个组的每个连续覆盖期都有一条线路。为此，我需要执行以下操作： 1) 识别日期完全在前一行的日期内的行（即 fromdate 较大，todate 较小）。然后我会删除这些日期飞地。 2）识别当前行的fromdate何时小于前一行的todate，即存在重叠覆盖。然后，我会将第一行的 todate 重写为该连续覆盖期间的最新 todate，并删除其他行。

我有代码要做 2)，但我在第 1 部分中苦苦挣扎。

到目前为止，我的方法是按 fromdate 排序并向下搜索 todate，直到找到更大的 todate。这将是所需的输出：

grp   fromdate     todate      drop
 1    2010-06-01   2016-12-31  0
 1    2012-02-01   2013-01-31  1
 1    2013-02-01   2015-10-31  1
 1    2013-02-01   2015-12-31  1
 1    2015-10-01   2016-01-31  1
 2    2011-02-01   2013-02-28  0
 2    2011-03-01   2013-02-28  1
 2    2013-04-01   2013-09-30  0
 2    2013-06-01   2016-12-31  0
 2    2013-10-01   2017-01-31  0
 3    2012-02-01   2014-01-31  0

应用第 2 部分）后，最终的 df 应该是这样的：

grp   fromdate     todate    
 1    2010-06-01   2016-12-31
 2    2011-02-01   2013-02-28
 2    2013-04-01   2017-01-31
 3    2012-02-01   2014-01-31

这可以计算到较大日期之前的行数，但仅限于未分组的数据：

df <- df %>%
arrange(grp, fromdate, todate) %>%
mutate(rows_to_max = sapply(1:length(todate), 
      function(x) min(which(.$todate[x:length(.$todate)] > .$todate[x]))-1)) %>%
ungroup()

我希望该解决方案与 dplyr 保持兼容，但对其他选项持开放态度。

提前致谢。

【问题讨论】：

“前一行”是指任何行，还是仅指前一行？
该组中的任何前一行。
第一个框中的代码已停止工作
你的答案看起来也很清晰，也许把它作为答案？
我修复了虚拟数据代码，它应该可以创建第三组

标签： r count row

【解决方案1】：

使用data.table::foverlap 匹配行，然后迭代地折叠它们。

grp <- rep(1:2, each = 5)
fromdate <- as.Date(c("2010-06-01", "2012-02-01", "2013-02-01", "2013-02-01", "2015-10-01", "2011-02-01", "2011-03-01", "2013-04-01", "2013-06-01", "2013-10-01"), origin = "1970-01-01")
todate <- as.Date(c("2016-12-31", "2013-01-31", "2015-10-31", "2015-12-31", "2016-01-31", "2013-02-28", "2013-02-28", "2013-09-30", "2016-12-31", "2017-01-31"), origin = "1970-01-01")
df <- data.frame(grp, fromdate, todate)

require(data.table)
setDT(df)
checklength <- 0

while (checklength != dim(df)[1]){

  # set our row count
  checklength <- dim(df)[1]

  # use data.table's foverlaps to match up rows
  setkey(df, grp, fromdate, todate)
  df <- foverlaps(df, df, mult = 'first')

  # collapse rows that have matched
  df[, todate   := pmax(todate, i.todate)]
  df[, fromdate := pmin(fromdate, i.fromdate)]
  df[, todate   := max(todate), .(grp, fromdate)]
  df[, fromdate := min(fromdate), .(grp, todate)]
  df <- unique(df[, .(grp, fromdate, todate)])
}

我想不出办法来摆脱这种迭代的本质。

【讨论】：

【解决方案2】：

假设你想删除包含在 any 前面的区间中的区间，lubridate 是你的朋友：

library(lubridate)
df$int <- interval(df$fromdate, df$todate)
drop <- sapply(2:nrow(df),  function(x) {
    any(df$int[x] %within% df$int[1:(x-1)])
})
df$drop <- c(FALSE, drop)

这还不能满足您按组进行操作的需要。以下应该可以工作，但不能：

df %>% 
    group_by(grp) %>% 
    mutate(
      drop = c(FALSE, sapply(2:n(), function(x) any(int[x] %within% int[1:(x-1)])))
    )

为什么不呢？我不确定，但有一些非常可怕的错误：

 tmp <- df %>% filter(grp==2)
 tmp

#    grp   fromdate     todate                            int
#  1   2 2011-02-01 2013-02-28 2010-06-01 UTC--2012-06-28 UTC
#  2   2 2011-03-01 2013-02-28 2012-02-01 UTC--2014-01-31 UTC   <<-  WTF???
#  3   2 2013-04-01 2013-09-30 2013-02-01 UTC--2013-08-02 UTC
#  4   2 2013-06-01 2016-12-31 2013-02-01 UTC--2016-09-02 UTC
#  5   2 2013-10-01 2017-01-31 2015-10-01 UTC--2019-01-31 UTC

因此，我们将避免混合间隔和分组数据帧。惩罚是一些丑陋的多方括号：

ivls <- interval(df$fromdate, df$todate)

df$idx <- 1:nrow(df)

df %>% 
  group_by(grp) %>% 
  mutate(
    drop = c(FALSE, sapply(2:n(), function(x) any(ivls[ idx[x] ] %within% ivls[ idx[1]:idx[x-1] ])))
  )

df

# Source: local data frame [10 x 5]
# Groups: grp [2]
# 
#      grp   fromdate     todate   idx  drop
#    <int>     <date>     <date> <int> <lgl>
# 1      1 2010-06-01 2016-12-31     1 FALSE
# 2      1 2012-02-01 2013-01-31     2  TRUE
# 3      1 2013-02-01 2015-10-31     3  TRUE
# 4      1 2013-02-01 2015-12-31     4  TRUE
# 5      1 2015-10-01 2016-01-31     5  TRUE
# 6      2 2011-02-01 2013-02-28     6 FALSE
# 7      2 2011-03-01 2013-02-28     7  TRUE
# 8      2 2013-04-01 2013-09-30     8 FALSE
# 9      2 2013-06-01 2016-12-31     9 FALSE
# 10     2 2013-10-01 2017-01-31    10 FALSE

【讨论】：

谢谢。这在第一组中效果很好，但在第 2 组中没有给出预期的结果：FALSE, FALSE, TRUE, FALSE, FALSE 我本来期望FALSE, TRUE, FALSE, FALSE, FALSE
再一次，这很好地解决了这个问题，除了一个实例。某些组只有一行，这会导致此错误：“错误：长度为 0 的参数”。我尝试使用if_else 来解决该问题：df %>% group_by(grp) %>% mutate(drop = if_else(n() > 1, c(FALSE, sapply(2:n(), function(x) any(ivls[idx[x]] %within% ivls[idx[1]:idx[x - 1]]))), FALSE)) 这也不起作用。使用ifelse 不会产生错误，但所有行都是 FALSE，因为 ifelse 去掉了区间的类。
其实，如果我先定义组的大小，使用 ifelse 会得到预期的结果：df %>% group_by(grp) %>% mutate(grpsize = n(), drop = ifelse(grpsize > 1, c(FALSE, sapply(2:n(), function(x) any(ivls[idx[x]] %within% ivls[idx[1]:idx[x - 1]]))), FALSE))
不幸的是，当我在整个数据集（150 万行，655k 组）上运行它时，它仍然在 40 分钟后运行，所以我中止了。

【解决方案3】：

这是我尝试解决此问题的另一种方法：

repeat {
  dfsize <-  nrow(df)
  df <- df%>%
    group_by(grp) %>%
    mutate(drop = ifelse((fromdate > lag(fromdate, 1) &
                            todate <= lag(todate, 1)) &
                           !is.na(lag(fromdate, 1)) &
                           !is.na(lag(todate, 1)),
                         1,
                         0
    )) %>%
    ungroup() %>%
    filter(drop == 0)
  dfsize2 <- nrow(df)
  if (dfsize2 == dfsize) {
    break
  }
}

它可以有效地处理我的数据子集（至少多达 100,000 行和 38,000 个组）。然而，当我尝试在 1.5m 行和 655,000 个组上运行它时，它似乎永远地运行（直到我中止）。我最终手动重复了 mutate 语句大约 20 次。

这只是数据问题的大小，还是有更有效的方法来解决问题？

【讨论】：