CODEWITHSUNDEEP
rmoving-average
greeny
greeny

Reputation: 445

Moving Average Function Issue

I have two vectors. Every day I want to add a row to make the dataset one row larger:

day1 <- c(0,0,8,10,4,5,3,5,6,10,7,11,9,7,10,13,8,7,5,4)
day2 <- c(0,0,8,10,4,5,3,5,6,10,7,11,9,7,10,13,8,7,5,4,0)

I have two functions that act as a cumulative mean and a rolling mean respectively. Both give the average with a lag of 1. 

cumroll <- function(x) {
    if(length(x)<=1) {x}
    else {
        x <- head(x, -1)
        c(head(x,1), cumsum(x) / seq_along(x))
    }
}

rollmean <- function(x, n) {if (length(x) <= n) cumroll(x) else rollapply(x,list(-seq(n)), mean, fill = cumroll(x))}

I am looking to do a rolling average of 20 on both datasets using this code:

day1_avg <- ave(day1, FUN = function(x) rollmean(x, 20))
day2_avg <- ave(day2, FUN = function(x) rollmean(x, 20))

When I run the day1_avg it acts as I would expect, with the cumroll acting since there has only been 20 observations. However when I run day2_avg with 21 observations, every value before the 21st observation is automatically given 0 rather than the cumroll values.

Results are below with my desired output for day2_avg:

day2     day1_avg     day2_avg    DESIRED
0        0            0           0
0        0            0           0
8        0            0           0
10       2.666667     0           2.666667
4        4.5          0           4.5
5        4.4          0           4.4
3        4.5          0           4.5
5        4.285714     0           4.285714
6        4.375        0           4.375
10       4.555556     0           4.555556
7        5.1          0           5.1
11       5.272727     0           5.272727
9        5.75         0           5.75
7        6            0           6
10       6.071429     0           6.071429
13       6.333333     0           6.333333
8        6.75         0           6.75
7        6.823529     0           6.823529
5        6.833333     0           6.833333
4        6.736842     0           6.736842
0                     6.6         6.6

I need to amend the functions somehow to make sure that cumroll values remain the same after the nth observation of the rollmean kicks in.

Any help would be hugely appreciated!

Upvotes: 0

Views: 103

Answers (1)

Robert
Robert

Reputation: 5152

Change your rollmean:

rollmean <- function(x, n) {if (length(x) <= n) tmp<- cumroll(x)
else {tmp<-rollapply(x,list(-seq(n)), mean, fill = cumroll(x))
tmp[1:n]<-cumroll(x[1:n])
}
tmp}

You will get:

> tail(cbind(day1,day1_avg,day2,day2_avg))
      day1 day1_avg day2 day2_avg
[17,]    8 6.750000    8 6.750000
[18,]    7 6.823529    7 6.823529
[19,]    5 6.833333    5 6.833333
[20,]    4 6.736842    4 6.736842
[21,]    0 0.000000    0 6.600000
[22,]    0 0.000000    1 6.600000

Upvotes: 2

Related Questions