R 带另一列的加权求和滚动

具有如下所示的data.frame：

library(dplyr)
test <- data.frame("name" = c("Scott","Scott","Scott","Scott","Scott","Scott"),
                   "minutes" = c(100, 50, 150, 200, 100, 250),
                   "grade" = c(2, 1.5, 2.5, 3, 2.2, 2.8))

这对整个样本来说是一个很好的加权评分，但我只查找最近的行，它们占了400分钟。我研究了滚动计算，但这些计算是基于行数，而不是小时数

---

为了清楚起见，我希望新列的前3行返回NA（因为前3行加起来有300分钟，因此不相关）；第4行将返回第2行、第3行和第4行的

加权_等级

（总共400分钟，因此第1行不相关）；第5行将返回第3行、第4行和第5行的

weighted_grade

（450分钟）；等等…

如果我理解正确的话

库（tidyverse）
图书馆（动物园）
#> 
#> 
#>as.Date，as.Date.numeric
测试%
变异（分子=等级*分钟，
cs_分子=rollapply（分子，
宽度=3，
乐趣=总和，
部分=T，
align=“right”），
cs_分母=滚动应用（分钟，
宽度=3，
乐趣=总和，
部分=T，
align=“right”），
res=ifelse（cs_分母>=400，cs_分子/cs_分母，NA））
#>姓名分钟等级分子cs\u分子cs\u分母res
#>1斯科特100 2.0 200 100北美
#>2斯科特50 1.5 75 275 150北美
#>3斯科特150 2.5 375 650 300北美
#>4斯科特200 3.0 600 1050 400 2.625000
#>5斯科特100 2.2 220 1195 450 2.655556
#>6斯科特250 2.8 700 1520 550 2.763636

由（v0.3.0）Rollappyr于2020-11-30创建，按名称分组，然后对每个名称使用

Rollappyr

。请注意，宽度可以是我们使用

findInterval

设置的向量

library(dplyr, exclude = c("filter", "lag"))
library(zoo)

test %>%
  group_by(name) %>%
  mutate(
    minutes0 = ifelse(is.na(minutes), 0, minutes),
    cumsum = cumsum(minutes0),
    mean = rollapplyr(1:n(),
      width = 1:n() - findInterval(cumsum - 400, cumsum),
      FUN = function(ix) if (sum(minutes0[ix]) < 400) NA
        else weighted.mean(grade[ix], minutes0[ix]),
      fill = NA)) %>%
  ungroup %>%
  select(name, minutes, grade, mean)

更新

---

代码略有改进。

在本例中，根据OP的原始数据集，没有一个大于400，我不确定是否可以始终使用

width=3

。看起来这不起作用，因为它实际上是对最后3个条目进行滚动求和。例如，如果“最后一分钟”条目是400，我希望它只取最后一行的

加权评分

。非常有效，谢谢！！实际上，它在我的大数据集中显示了一个错误，因为有些行包含NA<代码>错误：“mutate（）”输入“proj_块”有问题。x‘vec’必须按非递减方式排序，并且不包含NAs我可以在运行代码之前过滤掉它们，它工作正常，但不确定如何处理，因为在宽度参数中，对于cumsum，na.rm=TRUE不存在？假设它在分钟内引用NAs，请参阅修改后的答案。

library(dplyr, exclude = c("filter", "lag"))
library(zoo)

test %>%
  group_by(name) %>%
  mutate(
    minutes0 = ifelse(is.na(minutes), 0, minutes),
    cumsum = cumsum(minutes0),
    mean = rollapplyr(1:n(),
      width = 1:n() - findInterval(cumsum - 400, cumsum),
      FUN = function(ix) if (sum(minutes0[ix]) < 400) NA
        else weighted.mean(grade[ix], minutes0[ix]),
      fill = NA)) %>%
  ungroup %>%
  select(name, minutes, grade, mean)

# A tibble: 6 x 4
  name  minutes grade  mean
  <chr>   <dbl> <dbl> <dbl>
1 Scott     100   2   NA   
2 Scott      50   1.5 NA   
3 Scott     150   2.5 NA   
4 Scott     200   3    2.62
5 Scott     100   2.2  2.66
6 Scott     250   2.8  2.76

library(sqldf)

sqldf("with t1 as (
    select rowid id, *, sum(minutes) over (partition by name rows unbounded preceding) as cum from test
  )   
  select 
      a.name, 
      a.minutes, 
      a.grade, 
      iif (sum(b.minutes) < 400, Null, sum(b.grade * b.minutes) / sum(b.minutes)) as mean
    from t1 a 
    left join t1 b on b.cum > a.cum  - 400 and b.cum <= a.cum and a.name = b.name
    group by a.id")

   name minutes grade     mean
1 Scott     100   2.0       NA
2 Scott      50   1.5       NA
3 Scott     150   2.5       NA
4 Scott     200   3.0 2.625000
5 Scott     100   2.2 2.655556
6 Scott     250   2.8 2.763636