Lifetime Value(LTV)を予測する(2)
前回の続き
あといくつ記事を書けば年間50記事になるかな……
Rによる実装
前回お話したようにBTYDライブラリによって実現が可能です。
このライブラリには前処理に必要な関数も実装されていますが、
その多くはtidyverseによって再現ができます。
再現できる範囲で頑張ってます。でも最終的には
eclog %>% BTYD::dc.ElogToCbsCbt()
でどうにかなってしまう(ネタバレ)。
また、BTYDの実装ご理解には、主に以下を参照しています。
Buy ’Til You Die - A Walkthrough
Rおよび使用ライブラリのバージョンはこう！
> version _ platform x86_64-pc-linux-gnu arch x86_64 os linux-gnu system x86_64, linux-gnu status major 4 minor 0.2 year 2020 month 06 day 22 svn rev 78730 language R version.string R version 4.0.2 (2020-06-22) nickname Taking Off Again > packageVersion("tidyverse") [1] ‘1.3.0’ > packageVersion("BTYD") [1] ‘2.4’
下準備
データを読み込むやつをします。
# ライブラリの読み込み library(BTYD) # BTYDライブラリの読み込み library(tidyverse) # 呪文 # データの読み込み cdnow_log <- system.file("data/cdnowElog.csv", package = "BTYD") ec_log <- BTYD::dc.ReadLines(cdnow_log, cust.idx = 2, # customers' ID date.idx = 3, # purchase features sales.idx = 5 # sales features )
データ読み込みの部分ではBTYDライブラリにあるcdnowElogデータを使います。
dc.ReadLinesは、このあとにあるパラメータ推定にあたっての列インデックスを保持するための処理……のはずですが、
ただのdata.frame型なので多分推定そのものは普通の読み込みでも可能です。
以下に示すように「誰が(cust)、いつ(date)、いくら(sales)買ったのか」が分かるデータになっています。
ec_log %>% head() #> cust date sales #> 1 1 19970101 29.33 #> 2 1 19970118 29.73 #> 3 1 19970802 14.96 #> 4 1 19971212 26.48 #> 5 2 19970101 63.34 #> 6 2 19970113 11.77
前処理
今回はcust×dateでユニークにし、時系列も1997年9月30日までを使うことにします。
これは上記Walkthroughに準拠するにすぎないので、実務ではケースバイケースっすね。
ec_log_MTOSD <- BTYD::dc.MergeTransactionsOnSameDate(ec_log) class(ec_log_MTOSD) end_of_cal_period <- as.Date("1997-09-30") ec_log_MTOSD_cal <- ec_log_MTOSD[which(ec_log_MTOSD$date <= end_of_cal_period),]
なお、dc.MergeTransactionsOnSameDate関数を含む実行は、tidyverseに従う形で記述すると以下です。
ec_log_MTOSD <- ec_log %>% dplyr::mutate(date = lubridate::ymd(date)) %>% dplyr::group_by(cust, date) %>% dplyr::summarise(sales = sum(sales)) %>% dplyr::ungroup() %>% dplyr::filter(date <= lubridate::ymd("1997-09-30"))
dplyrの1.0.0以降はsummariseの挙動が変わるので、
summarise(.groups = "drop", sales = sum(sales))と書いてもいいんですが、
きぬいとのムーブとしてはパイプにungroup()をしておいたほうが、
バージョンのコンフリクトもそうですし、
関数の中に変数名以外を入れずに済むので、プログラミング得意じゃない人にもとっつきやすいんじゃないかなと思います*1。
まあ、Rの言語仕様やその裏の哲学の話は置いときましょう。
次はモデルの前提を踏まえた重要な前処理です。曰く
In the calibration period, the Pareto/NBD model is generally concerned with repeat transactions—that is, the first transaction is ignored.
前の記事で書いたPareto/NBDとかGG/NBDモデルは、
「購買の繰り返し」のモデルのため、初回購買をフィルタします。
ただ、様々なアニメ作品でも「初回」と「最終回」は重要であるので、購買においても重要です。
このため、dc.SplitUpElogForRepeatTransは、処理後のデータ(repeat.trans.elog)と、初回・最終回の情報を保持したデータ(cust.data)の両方を保持したリストとして結果を返します。
split_data <- BTYD::dc.SplitUpElogForRepeatTrans(ec_log_MTOSD_cal) # リストが返ってくる cleaned_elog <- split_data$repeat.trans.elog
もちろん、上記の関数もtidyverseっぽくさばけるんですが、
オブジェクトの保持の仕方が特殊なので、もしかするとココは素直にこの関数を使うほうが良いかも知れません。
無理やりやるとしたら、たとえば以下があります。
repeat_trans_elog <- ec_log %>% dplyr::group_by(cust) %>% dplyr::mutate(birth_per = min(date)) %>% dplyr::filter(date != birth_per) %>% dplyr::ungroup()%>% dplyr::select(-birth_per) cust_data <- ec_log %>% dplyr::group_by(cust) %>% dplyr::mutate(birth_per = min(date), last_date = max(date)) %>% dplyr::summarise(birth.per = birth_per[1], last.date = last_date[1], first.sales = sales[1], last.sales = sales[length(sales)]) %>% dplyr::ungroup() split_data_tidy <- list(repeat.trans.elog = repeat_trans_elog, cust.data = cust_data)
cust_dataの構成が非常に気持ち悪いですが、同じアウトプットが出るので我慢しましょう*2。
ここまでで作成したデータはlong形式の購買データになり、BTYDの解析フォーマットにするにはユーザ単位で購買をwide形式に展開します*3。
この際、1度だけの購買者も同様に横に展開できるよう試みます(tot_cbt)
# pivot_widerと同義 freq_cbt <- BTYD::dc.CreateFreqCBT(cleaned_elog) # 購買の繰り返しのない顧客を統合する tot_cbt <- BTYD::dc.CreateFreqCBT(ec_log_MTOSD) cal_cbt <- BTYD::dc.MergeCustomers(tot_cbt, freq_cbt)
最後に、キャリブレーションに用いるための購買が起きるまでの時間を推定するデータの作成です。
dc.BuildCBSFromCBTAndDates()で実行できます。
今回は週次でまとめます。
birth_periods <- splited_data$cust.data$birth.per last_dates <- splited_data$cust.data$last.date cal_cbs_dates <- data.frame( birth_periods, # first purchase by person last_dates, # last purchase by person end_of_cal_period # last purchase on global ) cal_cbs <- BTYD::dc.BuildCBSFromCBTAndDates( as.data.frame(cal_cbt), # cbt table. cal_cbs_dates, # dates parameter(end_of_cal_period). per = "week")
ちなみに上記のてつづきはdc.ElogToCbsCbt()でできるとか。えー。
個人的にはBTYDモデルの実行のためにどのようなデータがなぜ必要かが重要なので、
一通り前処理を行うほうがやりやすいと思います。
BTYDモデルの実行
今回はBTYDモデルの1実装であるPareto/NBDを試します。
具体的にはpnbd.EstimateParameters()を使うことで、各パラメータが得られます。
ただ、数値にラベルがないため注意が必要です。
結果はc(r, alpha, s, beta)の順に出力され、r, alphaは購買頻度の分布に置いている負の二項分布の形状と尺度パラメータ、
s, betaは、購買の間隔の分布に置いているパレート分布のパラメータです。このあたりは前の記事を読んでね。
パレート分布の代わりにベータ幾何分布を使う場合はggnbd.EstimateParameters()があります。
使う引数は同様なので、使いやすい。
推定は最尤法によって実装されていますが、初期値などはデフォルトのでやってみます。
最大化された対数尤度は、pnbd.cbs.LL()によって得られます。
params <- pnbd.EstimateParameters(cal.cbs = cal_cbs) params # r alpha s beta > [1] 0.5533971 10.5801985 0.6060625 11.6562237 LL <- pnbd.cbs.LL(params, cal_cbs) LL > [1] -9594.976
「これ、マジで収束してるの？」という場合は何度かモンテカルロしてみればいいと思います。
次にやりたいことは……
予測とかね。したいわよね。分かるわよ。
でもBTYDは使うデータがRFMで、例えば会員登録したばかりの人に対する予測が過小になるとか、
意外とPDCAを回したい人には都合の良くない条件などがあります。
それを打破するためにデモグラフィック情報を使ってパラメータを推定する試みなどもあるにはあるようです。
ただ、個人的にここまで実装しておいて「このご時世に、そもそもLTVを予測するよりも単純に離脱や購買数量を予測するほうが、素直に仕事に活かせるのでは？」と思ってしまったので、
次はもう少しLTVというマーケティング指標と現代的な研究について整理して来ようと思います。
