移動平均（rolling mean / moving mean)の計算方法

#Rで移動平均を計算してみた
会員の購買データから、直近3ヶ月の購買頻度をブランド(今回はABC）へのロイヤルティとみなして、計算しまして、その時使用したパッケージ、zooが便利だったのでメモ。

##やりたいこと
こんなデータから

| ID          | Weeks       |    Brand    |  purchase flg|
|:------------|------------:|------------:|:------------:|
| A           |      1      |     ABC     |      1       |
| A           |      2      |     ABC     |      1       |
| A           |      3      |     DEF     |      0       |
| A           |      4      |     ABC     |      1       |
| B           |      1      |     DEF     |      0       |
| B           |      2      |     DEF     |      0       |
| B           |      3      |     DEF     |      0       |
| B           |      4      |     ABC     |      1       |

直近2週間のABC購入率をloyaltyとした場合、こんなカラムをつくこと

| ID          | Weeks       |    Brand    |  purchase flg| loyalty   |
|:------------|------------:|------------:|:------------:|----------:|
| A           |      1      |     ABC     |      1       |     -     |
| A           |      2      |     ABC     |      1       |     -     |
| A           |      3      |     DEF     |      0       |    1.00   |
| A           |      4      |     ABC     |      1       |    0.50   |
| B           |      1      |     DEF     |      0       |     -     |
| B           |      2      |     DEF     |      0       |     -     |
| B           |      3      |     DEF     |      0       |    0.00   |
| B           |      4      |     ABC     |      1       |    0.00   |

前の週と、その前の週の購買のうち、ABCブランドの購入回数比率がここではloyaltyです。


##移動平均
移動平均、英語ではmoving meanやrolling meanなんて呼ばれまして、いろいろパッケージなり、自作で関数を作られてる方も見受けられますが、いざ自分で作ろうとするとちょっと面倒。。そんなときこの関数を見つけました。

##Rccpが便利！
大きく2ステップで求めます。
①当該週を含んだ、2週間で計算
②1周分ずらす

とりあえず、データを準備する。

```
rm(list = ls())

install.packages("zoo")
install.packages("data.table")
install.packages("dplyr")

library(zoo)
library(dplyr)
library(data.table)

#make data frame
table <- as.data.frame(matrix(rep(0, 3),nrow = 8))
table$ID <- rep(c("A", "B"), each = 4)
table$Weeks <- rep(1:4, 2)
table$Brand <- c("ABC", "ABC", "DEF", "ABC", "DEF", "DEF", "DEF", "ABC")
table <- table[,-1]
```

これで、下記のデータフレームができたので。

| ID          | Weeks       |    Brand    |
|:------------|------------:|:-----------:|
| A           |      1      |     ABC     |
| A           |      2      |     ABC     |
| A           |      3      |     DEF     |
| A           |      4      |     ABC     |
| B           |      1      |     DEF     |
| B           |      2      |     DEF     |
| B           |      3      |     DEF     |
| B           |      4      |     ABC     |


FLGを追加する。

```

#make FLG column
table$purchase_flg <- 0
table[table$Brand == c("ABC"), "purchase_flg"] <- 1
```

これで最初に載せたデータフレームが完成。やっと本番の移動平均へ。

| ID          | Weeks       |    Brand    |  purchase flg|
|:------------|------------:|------------:|:------------:|
| A           |      1      |     ABC     |      1       |
| A           |      2      |     ABC     |      1       |
| A           |      3      |     DEF     |      0       |
| A           |      4      |     ABC     |      1       |
| B           |      1      |     DEF     |      0       |
| B           |      2      |     DEF     |      0       |
| B           |      3      |     DEF     |      0       |
| B           |      4      |     ABC     |      1       |



で、ここからが本題の移動平均
##①当該週を含んだ、2週間で計算
group_byを使って、ID別に移動平均を計算。
(一応、パッケージのインストールから再掲）

```
install.packages("zoo")
install.packages("data.table")
install.packages("dplyr")

library(zoo)
library(dplyr)
library(data.table)


#calculate rolling mean
table <- table %>% 
  dplyr::group_by(ID) %>% 
  mutate(loyalty = rollmean(purchase_flg, 2, align = "right", fill = 0))
```

これで、下記のデータフレームができる。

| ID          | Weeks       |    Brand    |  purchase flg| loyalty   |
|:------------|------------:|------------:|:------------:|----------:|
| A           |      1      |     ABC     |      1       |    0.00   |
| A           |      2      |     ABC     |      1       |    1.00   |
| A           |      3      |     DEF     |      0       |    0.50   |
| A           |      4      |     ABC     |      1       |    0.50   |
| B           |      1      |     DEF     |      0       |    0.00   |
| B           |      2      |     DEF     |      0       |    0.00   |
| B           |      3      |     DEF     |      0       |    0.00   |
| B           |      4      |     ABC     |      1       |    0.50   |

補足をすると、
`align = "right"`  今週とその前の週の平均(1週目は前の週がないので、NAとなり、それ以降は当該週とその前の週の平均）
`align = "left"` で、当該週とその翌週の平均(1週目が計算できるようになり（1週目と2週目の平均）、4週目がその翌週がないので計算できなくなります）

`fill= 0` で計算できない場合の処理を指示しています。今回の場合では、計算できない1週目の値を0としています。計算できない場合を`NA`とするときは、`fill= 0`ではなく、下記のようにしてください。

```
table <- table %>% 
  dplyr::group_by(ID) %>% 
  mutate(loyalty = rollmean(purchase_flg, 2, align = "right", na.pad = TRUE))
```

##②1周分ずらす
今回は、前の週とその前の週の平均をloyaltyとしたいので、1週分データをずらします。

```
table <- table %>%
  group_by(ID) %>% 
  mutate(lag_loyalty = lag(loyalty, k = 1, default = 0))
```

これでこうなります。

| ID          | Weeks       |    Brand    |  purchase flg| loyalty   | lag_loyalty  |
|:------------|------------:|------------:|:------------:|----------:|-------------:|
| A           |      1      |     ABC     |      1       |    0.00   |    0.00      |
| A           |      2      |     ABC     |      1       |    1.00   |    0.00      |
| A           |      3      |     DEF     |      0       |    0.50   |    1.00      |
| A           |      4      |     ABC     |      1       |    0.50   |    0.50      |
| B           |      1      |     DEF     |      0       |    0.00   |    0.00      |
| B           |      2      |     DEF     |      0       |    0.00   |    0.00      |
| B           |      3      |     DEF     |      0       |    0.00   |    0.00      |
| B           |      4      |     ABC     |      1       |    0.50   |    0.00      |


`default = 0` で、ずらした場合の穴埋め方法を「0で埋める」と指定しています。