简体   繁体   中英

offset rollapply in R

I'd like to create two rolling windows from a dataframe in R.

The first rolling window which I have been able to create calculates the mean of row 1 to 3, and inserts the value in row 4, backfilled with NA.

The second rolling window which I would like help with, calculates the mean of row 1 to 4, and inserts the value in row 8, backfilled with NA.

Here is my current working example.

dfx <- do.call(rbind, Map(data.frame, A=c(1,2,3,4,5,6,7,8,9,10), B=c(0,0,2,2,0,0,1,0,0,0)))
dfx
    A B
1   1 0
2   2 0
3   3 2
4   4 2
5   5 0
6   6 0
7   7 1
8   8 0
9   9 0
10 10 0

My first rolling window is given with

library(zoo)
library(dplyr)
dfx <- as.data.frame(dfx %>% 
    mutate(roll_1 = lag(rollapply(B, 3, mean, fill=NA, align="right"),1)))

    A B    roll_1
1   1 0        NA
2   2 0        NA
3   3 2        NA
4   4 2 0.6666667
5   5 0 1.3333333
6   6 0 1.3333333
7   7 1 0.6666667
8   8 0 0.3333333
9   9 0 0.3333333
10 10 0 0.3333333

All you have to do is use the exact same call to zoo::rollapply but with a window of size 4, lagged 4.

library(dplyr)
library(zoo)

dfx %>% 
  mutate(roll_1 = lag(rollapply(B, 3, mean, fill=NA, align="right"),1),
         roll_2 = lag(rollapply(B, 4, mean, fill=NA, align="right"),4))
#>     A B    roll_1 roll_2
#> 1   1 0        NA     NA
#> 2   2 0        NA     NA
#> 3   3 2        NA     NA
#> 4   4 2 0.6666667     NA
#> 5   5 0 1.3333333     NA
#> 6   6 0 1.3333333     NA
#> 7   7 1 0.6666667     NA
#> 8   8 0 0.3333333      1
#> 9   9 0 0.3333333      1
#> 10 10 0 0.3333333      1

I feel like I don't understand your question because you just have to do the same thing as you did in your first roll but change some parameters.

The second parameter of zoo::rollapply is the amount of rows you want to aggregate, in your first example that's 3 rows, in your second example that's 4.

The second parameter of dplyr::lag determines your offset. In your first example you want to offset by 1 (3->4), in your second example you will want to offset by 4 (4->8).

This leaves us with the following code:

library(dplyr)
library(zoo)
dfx <- dfx %>% 
  mutate(roll_1 = lag(rollapply(B, 3, mean, fill=NA, align="right"),1),
         roll_2 = lag(rollapply(B, 4, mean, fill=NA, align="right"),4))

rollapplyr with an r on the end is like rollapply but defaults to right justification. Also the width can be a one element list containing a vector of offsets to use where 0 is the offset for the current value, -1 is the offset for the prior value and so on. Thus we have:

dfx %>%
  mutate(roll_1 = rollapplyr(B, list(-seq(3)), mean, fill = NA), 
         roll_2 = rollapplyr(B, list(-seq(4, 7)), mean, fill = NA))

giving:

    A B    roll_1 roll_2
1   1 0        NA     NA
2   2 0        NA     NA
3   3 2        NA     NA
4   4 2 0.6666667     NA
5   5 0 1.3333333     NA
6   6 0 1.3333333     NA
7   7 1 0.6666667     NA
8   8 0 0.3333333      1
9   9 0 0.3333333      1
10 10 0 0.3333333      1

or without dplyr:

transform(dfx, roll_1 = rollapplyr(B, list(-seq(3)), mean, fill = NA), 
               roll_2 = rollapplyr(B, list(-seq(4, 7)), mean, fill = NA))

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM