Googleタグマネージャーで集めたアクセスログデータを用いて、前回と同様に記事のレコメンドにチャレンジしてみようと思います。FactoRizationMachinesパッケージという便利そうなパッケージの存在も知れたことから、今回は以前から気になっていたFactorization Machineを扱います。

【目次】
・Factorization Machine(FM)の概要
・パッケージ紹介とインストール
・サンプルデータの構造把握と前処理
・FMの実行
・結果
・参考文献

Factorization Machine(FM)の概要

組み合わせ特徴量を扱う教師あり学習モデル。行列分解とSVMを合体させた手法。
スパースになりやすいデータの予測問題で扱う。
1ユーザーのある商品に対しての評価を、1評価1行として表して、ユーザーとアイテムの交互作用の特徴ベクトルを扱う。
相互作用項に関して、時間や文脈などを自由に入れられる。
相互作用項を次元圧縮する際の要素数を事前に決める必要がある。
Matrix Factorizationよりも精度が良いとされている。特徴量エンジニアリングなどで使われているようです。（Click-Through Rate Prediction）

パッケージ紹介とインストール

FactoRizationMachinesパッケージは線形SVMと2次のFMと高次のFMを実行することができ、引数で正則化項も加えることができます。現段階においては回帰のみで分類問題への適用は今後の開発となるようです。CRANから普通に
install.packages(‘FactoRizationMachines’)
でインストールします。libFMexeパッケージの場合は、libFMをインストールしてパスを指定しておく必要がありますが、このパッケージに関しては不要となります。

サンプルデータの構造把握と前処理

FactoRizationMachinesパッケージのサンプルコードにおいては、MovieLensのデータがサンプルデータとして載せられていました。ユーザーのID(整数)、映画のID(整数)、評価(整数、5段階)、日時(整数)からなるデータに対して、sparseMatrixに変換していました。

今回は、前回の投稿非負値行列因子分解(NMF)でブログ記事のレコメンドをしてみると同じデータを使って、アクセスログデータに適用しようと思います。FactoRizationMachinesの形式に合わせるために、このブログのアクセスログも、クッキーのIDを整数に、記事のIDを整数に、閲覧回数を5段階(5以上を5に変換)に、日時を整数に変更しています。

library(RGA)
library(tidyverse)
library(reshape2)

authorize()
prof <-list_profiles()

start_date <- "2017-07-04"
end_date   <- "2017-10-07"

#demention until 7
accesslogdata <- get_ga(profileId = prof$id[2],
                        start.date = start_date,
                        end.date = end_date,
                        dimensions = "ga:pagePath,
                        ga:dimension1,
                        ga:dateHourMinute,
                        ga:deviceCategory,
                        ga:userType,
                        ga:fullReferrer",
                        sort = "-ga:sessions",
                        metrics = "ga:sessions,ga:goal1Completions,ga:pageviews",
                        fetch.by = "day")

accesslogdata$pagePath <- vapply(strsplit(accesslogdata$pagePath,"\\?"), `[`, 1, FUN.VALUE=character(1))
accesslogdata <- accesslogdata %>% filter(grepl(x = pagePath,"/archives/[0-9]+$"))
accesslogdata$pagePath <- gsub(accesslogdata$pagePath,pattern = "/archives/",replacement = "article_")

#ユーザーIDの整数化
user <- unique(accesslogdata$dimension1)
user <- data.frame(dimension1=user) %>% mutate(user_number=1:n())

#記事IDの整数化
articles <- unique(accesslogdata$pagePath)
articles <- data.frame(pagePath=articles) %>% mutate(article_number=1:n())

#データの結合
accesslogdata <- accesslogdata %>% mutate(date=as.numeric(as.POSIXlt(as.Date(format(substr(accesslogdata$dateHourMinute,start = 1,stop = 12), format="%Y%m%d%"),format = "%Y%m%d"))))
accesslogdata <- accesslogdata %>% left_join(articles,by="pagePath")
accesslogdata <- accesslogdata %>% left_join(user,by="dimension1")

#最終接触日の抽出
last_date <- accesslogdata %>% select(user_number,article_number,date) %>% 
                arrange(user_number,desc(date))
last_date <- last_date[!duplicated(last_date[c("user_number","article_number")]),]

#各ユーザーの各記事に対するページビュー数の集計
accesslogdata_sum <- accesslogdata %>% group_by(article_number,user_number) %>% summarise(pageview=n()) %>% 
                        select(user_number,article_number,pageview)
accesslogdata_sum <- accesslogdata_sum %>% mutate(pageview=ifelse(pageview < 5,pageview,5))

accesslogdata_sum <- accesslogdata_sum %>% left_join(last_date, by = c("user_number" = "user_number", "article_number" = "article_number"))

library(RGA)

library(tidyverse)

library(reshape2)

authorize()

prof <-list_profiles()

start_date <- "2017-07-04"

end_date <- "2017-10-07"

#demention until 7

accesslogdata <- get_ga(profileId = prof$id[2],

start.date = start_date,

end.date = end_date,

dimensions = "ga:pagePath,

ga:dimension1,

ga:dateHourMinute,

ga:deviceCategory,

ga:userType,

ga:fullReferrer",

sort = "-ga:sessions",

metrics = "ga:sessions,ga:goal1Completions,ga:pageviews",

fetch.by = "day")

accesslogdata$pagePath <- vapply(strsplit(accesslogdata$pagePath,"\\?"), `[`, 1, FUN.VALUE=character(1))

accesslogdata <- accesslogdata %>% filter(grepl(x = pagePath,"/archives/[0-9]+$"))

accesslogdata$pagePath <- gsub(accesslogdata$pagePath,pattern = "/archives/",replacement = "article_")

#ユーザーIDの整数化

user <- unique(accesslogdata$dimension1)

user <- data.frame(dimension1=user) %>% mutate(user_number=1:n())

#記事IDの整数化

articles <- unique(accesslogdata$pagePath)

articles <- data.frame(pagePath=articles) %>% mutate(article_number=1:n())

#データの結合

accesslogdata <- accesslogdata %>% mutate(date=as.numeric(as.POSIXlt(as.Date(format(substr(accesslogdata$dateHourMinute,start = 1,stop = 12), format="%Y%m%d%"),format = "%Y%m%d"))))

accesslogdata <- accesslogdata %>% left_join(articles,by="pagePath")

accesslogdata <- accesslogdata %>% left_join(user,by="dimension1")

#最終接触日の抽出

last_date <- accesslogdata %>% select(user_number,article_number,date) %>%

arrange(user_number,desc(date))

last_date <- last_date[!duplicated(last_date[c("user_number","article_number")]),]

#各ユーザーの各記事に対するページビュー数の集計

accesslogdata_sum <- accesslogdata %>% group_by(article_number,user_number) %>% summarise(pageview=n()) %>%

select(user_number,article_number,pageview)

accesslogdata_sum <- accesslogdata_sum %>% mutate(pageview=ifelse(pageview < 5,pageview,5))

accesslogdata_sum <- accesslogdata_sum %>% left_join(last_date, by = c("user_number" = "user_number", "article_number" = "article_number"))

FMの実行

デフォルトの設定c(1, 10)では線形のウェイトが有効で、2次の項の要素数が10で正則化項なしのFMを実行することになります。引数に関する詳しい情報はPackage ‘FactoRizationMachines’に書かれています。今回はサンプルを参考に正則化項ありでモデルを実行します。まず、アクセスログデータに対して、ユーザーのIDからなる整数ベクトル、記事のIDからなる整数ベクトル、セッションのあった日時のデータからなる整数ベクトルを作成し、sparseMatrix関数を用いて元データを変形し、80%のデータをトレーニングに、20%のデータをテストに割り当てます。さらに、テストデータに関して、予測値との平均二乗誤差を計算します。

library(FactoRizationMachines)
library(Matrix)

user = accesslogdata_sum$user_number
items = accesslogdata_sum$article_number + max(user)
wdays = (as.POSIXlt(accesslogdata_sum$date,origin="2017-07-04")$wday+1)+max(items)

# Transform access log to feature form
data = sparseMatrix(i=rep(1:nrow(accesslogdata_sum),3),j=c(user,items,wdays),giveCsparse=F)
target = accesslogdata_sum$pageview

# Subset data to training and test data
set.seed(123)
subset = sample.int(nrow(data),nrow(data)*.8)
data.train = data[subset,]
data.test = data[-subset,]
target.train = target[subset]
target.test = target[-subset]

# Predict ratings with Support Vector Machine with linear kernel
model = SVM.train(data.train,target.train)

# RMSE resulting from test data prediction
sqrt(mean((predict(model,data.test)-target.test)^2))

# Predict ratings with second-order Factorization Machine
# with second-order 10 factors (default) and regularization
model = FM.train(data.train,target.train,regular=0.1)
# RMSE resulting from test data prediction
sqrt(mean((predict(model,data.test)-target.test)^2))

library(FactoRizationMachines)

library(Matrix)

user = accesslogdata_sum$user_number

items = accesslogdata_sum$article_number + max(user)

wdays = (as.POSIXlt(accesslogdata_sum$date,origin="2017-07-04")$wday+1)+max(items)

# Transform access log to feature form

data = sparseMatrix(i=rep(1:nrow(accesslogdata_sum),3),j=c(user,items,wdays),giveCsparse=F)

target = accesslogdata_sum$pageview

# Subset data to training and test data

set.seed(123)

subset = sample.int(nrow(data),nrow(data)*.8)

data.train = data[subset,]

data.test = data[-subset,]

target.train = target[subset]

target.test = target[-subset]

# Predict ratings with Support Vector Machine with linear kernel

model = SVM.train(data.train,target.train)

# RMSE resulting from test data prediction

sqrt(mean((predict(model,data.test)-target.test)^2))

# Predict ratings with second-order Factorization Machine

# with second-order 10 factors (default) and regularization

model = FM.train(data.train,target.train,regular=0.1)

# RMSE resulting from test data prediction

sqrt(mean((predict(model,data.test)-target.test)^2))

結果

各モデルについての平均二乗誤差を計算しています。
線形モデルや高次元モデルよりも、2次の項を持つFMが精度が高いようです。

> model = SVM.train(data.train,target.train)
> sqrt(mean((predict(model,data.test)-target.test)^2))
[1] 1.514266
> model = FM.train(data.train,target.train,regular=0.1)
> sqrt(mean((predict(model,data.test)-target.test)^2))
[1] 1.369983
> model　=　HoFM.train(data.train,target.train,c(1,3,1),regular=0.1)
> sqrt(mean((predict(model,data.test)-target.test)^2))
[1] 1.388247

> model = SVM.train(data.train,target.train)

> sqrt(mean((predict(model,data.test)-target.test)^2))

[1] 1.514266

> model = FM.train(data.train,target.train,regular=0.1)

> sqrt(mean((predict(model,data.test)-target.test)^2))

[1] 1.369983

> model　=　HoFM.train(data.train,target.train,c(1,3,1),regular=0.1)

> sqrt(mean((predict(model,data.test)-target.test)^2))

[1] 1.388247

こちらは、この中で性能の良かった2次の項を持つFMの予測結果とテストデータの結果をプロットしたものです。4点を超える値をあまり予測できていないようです。今回はサンプルを回しただけなので、本来であれば次元の数kや正則化のセッティングをいろいろいじったり、相互作用項を新しく追加するなどして精度を高めることが必要です。

結果の比較だけでは仕事で使えないので、実際に予測した結果を取り出したいと思います。
実際に運用するとなると、ページIDを所与として、ページビュー数を0とおいて（型をそろえるため。NULLだとエラーになった）、任意のタイミング(date)を想定して、モデルにデータを適用し、評価の高いものをサジェストするスタイルになるのではないでしょうか。

この結果だと、ユーザー98に記事1を見せることに対して4.02点が与えられています。

参考文献

Factorization Machinesを今更読みました
 Factorization Machines
High-order factorization machines with R #tokyor 61
Factorization Machinesのおはなし。
libFMexeを動かすまで (R Wrapper for the libFM Executable参照記事)
一歩Matrix Factorization、二歩Factorization Machines、三歩Field-aware Factorization Machines…『分解、三段突き！！』
[論文] Factorization Machines (ICDM 2010) 読んだ 22:41
Factorization machines with r
Factorization Machinesについて調べてみた

RのFactoRizationMachinesパッケージを用いたFMのページビューデータへの適用

Factorization Machine(FM)の概要

パッケージ紹介とインストール

サンプルデータの構造把握と前処理

FMの実行

結果

参考文献

コメントを残すコメントをキャンセル

Factorization Machine(FM)の概要

パッケージ紹介とインストール

サンプルデータの構造把握と前処理

FMの実行

結果

参考文献

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル