#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で埋める」と指定しています。