[英]conditional rolling average in R
dat <- structure(list(yearRef = c(1970, 1971, 1972, 1973, 1974, 1975,
1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986,
1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018),
value = c(0.761253538863966, 0.778365700864592, 0.748473422160476,
0.790408287413012, 0.726707786670043, 0.80587461240495, 0.81582881742434,
0.914998995290579, 0.903241004636529, 0.883446087736501,
0.878399385374308, 0.790239960507709, 0.853841173129717,
0.972923769177295, 0.899133969911117, 0.865840008976815,
0.85942147306247, 0.9471790327507, 0.905362802563981, 0.91644169495142,
0.985789564141214, 0.978212191208007, 0.885157529562834,
1.01638026873823, 1.02702020472382, 0.944421276774342, 0.979439113456467,
0.951183598644539, 1.12054063623421, 1.00767230122493, 1.02132151007705,
0.95649988168142, 0.928385199359045, 1.05071183719421, 1.11654102944792,
0.910601547182633, 0.936460862711605, 1.2398210426787, 0.979036947391532,
1.09931214756341, 1.12206830109171, 0.997384903912461, 1.07413151131128,
0.967026290186151, 1.04921352764649, 1.08746580600605, 1.02444885186573,
1.14604631626466, 1.06449109417896)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -49L))
For each year, I want to calculate the mean of top 5 values from the previous 7 values.对于每一年,我想计算前 7 个值中前 5 个值的平均值。 For eg the first mean value will be for 1977 and will consist of mean of best 5 years from 1970 till 1976. Similarly, for 1978, mean value will be the top 5 values from 1971-1977.例如,第一个平均值将是 1977 年,包括从 1970 年到 1976 年的最佳 5 年的平均值。类似地,对于 1978 年,平均值将是 1971 年至 1977 年的前 5 个值。 Similarly, for 2018, the mean value will be top 5 values from 2011 - 2017同样,对于 2018 年,平均值将是 2011-2017 年的前 5 个值
I have the following code from SO which sort of does the job.我有以下来自 SO 的代码,它可以完成这项工作。
library(data.table)
library(zoo)
setDT(dat)
dat[, mean.val:= if (.N > 6)
rollapplyr(value, 7,function(x) mean(tail(sort(x), 5)), fill = NA)
else mean(value)]
though the first value in the new column mean.val
is correct, it should be assigned to the row which has 1977 but has been assigned to 1976.尽管新列mean.val
的第一个值是正确的,但它应该分配给具有 1977 但已分配给 1976 的行。
You want to process the PRIOR 7 points rather than the 7 points that end at the current point.您要处理PRIOR 7 点而不是在当前点结束的 7 点。 To do that use a width of list(-(1:7))
.为此,请使用list(-(1:7))
的宽度。 That says to use offsets -1 through -7 when processing the data.也就是说在处理数据时使用偏移量 -1 到 -7。 See ?rollapply
for more information on specifying the width
argument.有关指定width
参数的更多信息,请参阅?rollapply
。
This (1) more directly specifies the intention making it easier to comprehend than approaches which require ignoring the required offsets and then fixing it up later and (2) uses only the packages you are already using (3) expresses the solution compactly and (4) preserves your solution changing only one argument.这 (1) 更直接地指定意图,使其比需要忽略所需偏移量然后稍后修复它的方法更容易理解和 (2) 仅使用您已经在使用的包 (3) 紧凑地表达解决方案和 (4 ) 保留您的解决方案,仅更改一个参数。
dat[, mean.val:= if (.N > 6)
rollapply(value, list(-(1:7)), function(x) mean(tail(sort(x), 5)), fill = NA)
else mean(value)]
If the only issue is that the values should be shifted down 1 row, you can use shift
to fix this.如果唯一的问题是值应该向下移动 1 行,您可以使用shift
来解决这个问题。
dat[, mean.val := shift(mean.val)]
FYI if you're on version >= 1.12.4 data.table you don't need zoo and can use data.table::frollapply
.仅供参考,如果您使用的是 >= 1.12.4 data.table 版本,则不需要 zoo 并且可以使用data.table::frollapply
。
dat[, mean.val2 :=
shift(frollapply(value, 7, function(x) mean(tail(sort(x), 5))))]
dat[, all.equal(mean.val, mean.val2)] #TRUE
I think you can use the excellent tsibble package for an amazing rolling function and then you can use the lead function to displace the results我认为您可以使用出色的 tsibble 包来实现惊人的滚动功能,然后您可以使用 Lead 功能来替换结果
library(tidyverse)
dat <- structure(list(yearRef = c(1970, 1971, 1972, 1973, 1974, 1975,
1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986,
1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018),
value = c(0.761253538863966, 0.778365700864592, 0.748473422160476,
0.790408287413012, 0.726707786670043, 0.80587461240495, 0.81582881742434,
0.914998995290579, 0.903241004636529, 0.883446087736501,
0.878399385374308, 0.790239960507709, 0.853841173129717,
0.972923769177295, 0.899133969911117, 0.865840008976815,
0.85942147306247, 0.9471790327507, 0.905362802563981, 0.91644169495142,
0.985789564141214, 0.978212191208007, 0.885157529562834,
1.01638026873823, 1.02702020472382, 0.944421276774342, 0.979439113456467,
0.951183598644539, 1.12054063623421, 1.00767230122493, 1.02132151007705,
0.95649988168142, 0.928385199359045, 1.05071183719421, 1.11654102944792,
0.910601547182633, 0.936460862711605, 1.2398210426787, 0.979036947391532,
1.09931214756341, 1.12206830109171, 0.997384903912461, 1.07413151131128,
0.967026290186151, 1.04921352764649, 1.08746580600605, 1.02444885186573,
1.14604631626466, 1.06449109417896)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -49L))
complex_function <- . %>%
sort %>%
tail(.,5) %>%
mean
dat %>%
mutate(roll_avg = tsibble::slide_dbl(.x = value,.f = complex_function,.size = 7),
roll_avg2 = lag(roll_avg))
#> # A tibble: 49 x 4
#> yearRef value roll_avg roll_avg2
#> <dbl> <dbl> <dbl> <dbl>
#> 1 1970 0.761 NA NA
#> 2 1971 0.778 NA NA
#> 3 1972 0.748 NA NA
#> 4 1973 0.790 NA NA
#> 5 1974 0.727 NA NA
#> 6 1975 0.806 NA NA
#> 7 1976 0.816 0.790 NA
#> 8 1977 0.915 0.821 0.790
#> 9 1978 0.903 0.846 0.821
#> 10 1979 0.883 0.865 0.846
#> # … with 39 more rows
Created on 2020-01-14 by the reprex package (v0.3.0)由reprex 包(v0.3.0) 于 2020 年 1 月 14 日创建
This simple for loop solve the problem:这个简单的 for 循环解决了这个问题:
dat$mean.val = NA
for(i in 8:nrow(dat))
{
dat$mean.val[i] = mean(sort(dat$value[(i-7):(i-1)],decreasing = TRUE)[1:5])
}
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.