如何计算R中的3个月移动平均值并为Month创建列名称？

Question

我有一个数据框df

str(df)

'data.frame':   396 obs. of  23 variables:
 $ Year         : chr  "1986" "1986" "1986" "1986" ...
 $ Month        : chr  "Jan" "Feb" "Mar" "Apr" ...
 $ Season       : Factor w/ 4 levels "Monsoon","PostMonsoon",..: 4 4 3 3 3 1 1 1 2 2 ...
 $ stn1         : num  2.3 42.3 91.1 267.4 482.1 ...
 $ stn2         : num  0 9 23.8 61.7 68.3 ...
 $ stn3         : num  0 10 34.6 52.5 122 …

我想计算三个月的滚动平均值，并尝试了以下代码

library(zoo)

Roll_mean <- function(x){rollmean(x,3)} #creating a function to calculate 3 month rolling mean

monthroll_mean <- df[-2] %>% group_by(Year, Season) %>% summarise_all(list(Roll_mean))

但是我没有得到我期望的。

例如，我希望我的最终数据框像这样。

head(monthroll_mean)

Year  Months   stn1   stn2    stn3 
  <chr> <fct>   <dbl>    <dbl>  <dbl>  
1 1986  DJF      32.0    10.0    10       
2 1986  JFM    1157.    141.    282.       
3 1986  FMA    280.     51.3    69.7      
4 1986  MAM     352.     78.5   121.        
5 1986  AMJ      27.3     4.47   20.5        
6 1986  MJJ    1005.    139.    235        

我如何创建一个“月份”列，需要3个月的滚动平均值。

您的帮助将不胜感激

Answer 1

您可以尝试：

library(dplyr)
df %>% 
  group_by(Year, Season) %>% 
  mutate_at(vars(starts_with('stn')), ~zoo::rollapplyr, 3, fill = NA)

Answer 2

尝试这样的事情：

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

df <- expand.grid(year=1991:1995,
                  month=month.abb) %>% 
  arrange(year,month) %>% 
  mutate(var1=runif(nrow(.),10,20),var2=runif(nrow(.),10,20))
head(df,10) #dummy data
#>    year month     var1     var2
#> 1  1991   Jan 13.19097 12.44519
#> 2  1991   Feb 17.02439 10.55053
#> 3  1991   Mar 11.21088 17.08536
#> 4  1991   Apr 19.73014 17.60298
#> 5  1991   May 12.72299 12.95819
#> 6  1991   Jun 17.19959 19.90314
#> 7  1991   Jul 11.47601 17.77892
#> 8  1991   Aug 10.43157 14.51260
#> 9  1991   Sep 13.66881 14.34805
#> 10 1991   Oct 13.50884 11.62024


library(zoo)
#> 
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#> 
#>     as.Date, as.Date.numeric

rolldf <-  df %>% 
  mutate(months=rollapply(month,3,function(x){
    paste(substr(x,1,1),collapse = '')
  },align='right',fill=NA)) %>% 
  mutate_at(vars(var1,var2),~rollmean(.,k=3,align = 'right',fill=NA))

head(rolldf)
#>   year month     var1     var2 months
#> 1 1991   Jan       NA       NA   <NA>
#> 2 1991   Feb       NA       NA   <NA>
#> 3 1991   Mar 13.80875 13.36036    JFM
#> 4 1991   Apr 15.98847 15.07962    FMA
#> 5 1991   May 14.55467 15.88217    MAM
#> 6 1991   Jun 16.55091 16.82144    AMJ

^{由reprex package（v0.3.0）在2020-02-13创建}