r - 基于拆分组和 R 中的先前时间段进行聚合

Question

我有一个包含日期(“anchor_dates”)的列表和一个包含按组和测试日期(“组”)结果的数据框。

anchor_dates <- as.Date(c("2015-07-20","2015-07-21","2015-07-22"))
set.seed(3)
groups <- data.frame(Test.Date = as.Date(c(rep("2015-07-18", 3), rep("2015-07-19", 3), rep("2015-07-20", 3), rep("2015-07-21", 3))), 
              Group = rep(c("AAA","BBB","CCC"), 4), Var1 = round(runif(12,0,10), ), Var2 = round(runif(12,0,7)))

> head(groups)
    Test.Date Group Var1 Var2
1  2015-07-18   AAA    2    4
2  2015-07-18   BBB    8    4
3  2015-07-18   CCC    4    6
4  2015-07-19   AAA    3    6
5  2015-07-19   BBB    6    1
6  2015-07-19   CCC    6    5

我需要使用“anchor_dates”列表中的日期作为“groups”集中的 anchor ，并按组从 anchor 日期之前的前两个测试日期聚合变量。给定组的每个测试日期可能并不总是有结果，所以我不能使用 subset() 将 anchor 日期减去 1 和 2。我需要能够为每个组提取最后两个测试日期在锚定日期之前，无论它们有多远并且不连续。

以下内容让我很接近，但是当我尝试这样做时

unsplit(temp, groups$Group)

聚合后，返回的是一个展平的集合，它在重复相同的 Var 总和时有问题，并且不允许我在添加“anchor_dates”列表中的 anchor 日期之后在集合上使用 Map()。

f <- lapply(anchor_dates, function(x) {
    lapply(split(groups, groups$Group), function(y) {
        temp <- tail(y[order(y$Date == x), ], 2)
        temp <- aggregate(cbind(Var1, Var2) ~ Group, data = temp, FUN = sum)
     })
})

[[1]]
[[1]]$AAA
  Group Var1 Var2
1   AAA    7    6

[[1]]$BBB
  Group Var1 Var2
1   BBB    8    3

[[1]]$CCC
  Group Var1 Var2
1   CCC   11    3
..............

最终结果应该像下面这样返回(或类似的解决方案)

[[1]]
  Group Var1 Var2
1   AAA    5   10
2   BBB   14    5
3   CCC   10   11

[[2]]
  Group Var1 Var2
1   AAA    4   12
2   BBB    9    3
3   CCC   12    7

[[3]]
  Group Var1 Var2
1   AAA    7    6
2   BBB    8    3
3   CCC   11    3

这让我得到以下结果

f1 <- Map(cbind, f, anchor_dates) 
do.call(rbind, f1)

  Group Var1 Var2 Anchor.Date
1   AAA    5   10  2015-07-20
2   BBB   14    5  2015-07-20
3   CCC   10   11  2015-07-20
4   AAA    4   12  2015-07-21
5   BBB    9    3  2015-07-21
6   CCC   12    7  2015-07-21
7   AAA    7    6  2015-07-22
8   BBB    8    3  2015-07-22
9   CCC   11    3  2015-07-22

Answer 1

我使用一个函数和另一个函数来完成这个。外部函数适合使用子集数据帧使用 by() 调用，而内部函数允许我们检查多个锚定日期。

func.get_agg_values <- function(df.groupdata,list_of_anchor_dates) {

    df.returndata <- lapply(X = list_of_anchor_dates,
                            active.group.df = df.groupdata,
                            FUN = function(anchor.date,active.group.df) {

                                # Get order of the data frame in a proper order
                                active.group.df <- active.group.df[order(active.group.df$Test.Date,decreasing = TRUE),]

                                # Next, we subset active.group.df to those rows that are before the anchor date
                                # Since it was ordered, we can just take 1 and 2 as the last two dates before the anchor date
                                active.group.df <- active.group.df[as.numeric(active.group.df$Test.Date - anchor.date) < 0,][1:2,]

                                # Finally, get the sums and return a data frame
                                returned.row.df <- data.frame(Group = unique(active.group.df$Group),
                                                          Var1 = sum(active.group.df$Var1),
                                                          Var2 = sum(active.group.df$Var2),
                                                          Anchor.Date = anchor.date)
                                return(returned.row.df)
                            })
    return(do.call(what = rbind.data.frame,
                   args = df.returndata))
}
f1 <- do.call(what = rbind.data.frame,
              args = by(data = groups,
                        INDICES = groups$Group,
                        FUN = func.get_agg_values,
                        list_of_anchor_dates = anchor_dates))

> f1
      Group Var1 Var2 Anchor.Date
AAA.1   AAA    5   10  2015-07-20
AAA.2   AAA    4   12  2015-07-21
AAA.3   AAA    7    6  2015-07-22
BBB.1   BBB   14    5  2015-07-20
BBB.2   BBB    9    3  2015-07-21
BBB.3   BBB    8    3  2015-07-22
CCC.1   CCC   10   11  2015-07-20
CCC.2   CCC   12    7  2015-07-21
CCC.3   CCC   11    3  2015-07-22