ユーザがじわじわと課金を積んでいく時系列データをクラスタリングしたい
下図ではサービス利用開始の0日目から30日目までの、個々のユーザが課金を積み上げていく様子(のダミーデータ)を示しました。
この記事では
「このデータから『早熟ユーザ』『毎日じっくり課金するユーザ』『遅咲きユーザ』といった課金の積み上げ方のスタイルを抽出できないか？」という観点でクラスタリングを行っていきます。
前準備としてのスケーリング
とはいっても、上述のようなデータをいきなりクラスタリングしても「ものすごい課金してる人&その他大勢」のような結果が出てしまい、今回の関心の対象であるところの課金の積み上げ方のスタイルを表現することができなかったりします。
そこで「個々のユーザの最終的な合計課金金額」を最大値とするスケーリングを施し、全てのユーザのデータが0〜1の範囲におさまるように調節します。金額の多寡についての情報を捨てて、「いつ課金してくれたか？」を際立たせます。
すると、グラフとコードは以下のようになります。
序盤に課金したっきり課金がストップする人、レイトスターターな人などが見えるようになりました。
d <- d %>% arrange(user_id, time) %>% group_by(user_id) %>% mutate(sum_pay = sum(pay)) %>% mutate( cum_pay = cumsum(pay), cum_pay_scaled = if_else(sum_pay == 0, 0, cumsum(pay) / sum(pay)) ) %>% ungroup() d %>% ggplot( aes(time, cum_pay_scaled, color=as.factor(user_id)) ) + geom_line() + guides(color=F)
どのような距離尺度でクラスタリングするか？
時系列データのクラスタリングというテーマについて、今回は以下の記事を参考にさせていただきました。
- {TSclust} ではじめる時系列クラスタリング - StatsFragments
- Pythonで、時系列データをクラスタリングしてみよう | NHN テコラス Tech Blog | AWS、機械学習、IoTなどの技術ブログ
例えば時系列データ向けの距離尺度の一例としてDTWというものがあります。次に引用するのは、後者のNHNさんのブログからのものです。
音声認識タスクでは同じ発話でも話者によって(または同じ話者でも状況によって)そのスピードが違います。このようなズレを補完するためにDynamic Time Wrapping (DTW)のような距離関数が用いられます。
今回の解析では「早熟か？遅咲きか？」のような時系列上の隔たりを距離としてキチンと評価したいので、選択肢は色々とありますが、まずはシンプルにユークリッド距離を使うこととしました。また、クラスタリング手法にはkmeans法を使うこととしました。
クラスタリングしてみた結果
以下、クラスタリングした結果のグラフとコードです。
ここでは簡単のため、クラスタ数の検討をスキップして適当に k=6としました。
クラスタ2では全く課金しないクラスタ、クラスタ3では遅咲きなクラスタを表現できているように見えます。一方、クラスタ4と6は何度も課金している人と一回しか課金しない人の両者を含むように見えます。このデータに関してはクラスタリングが上手くいったとは言えません。
※今回はダミーデータの生成の過程で正規分布を取り入れているので「毎日課金してるクラスタの人数が多い」のような結果になっていますが、実際はこうなりません。おそらくほとんどのサービスでは。
# 時系列を横持ちにして余計なデータを削ぎ落とす d.f <- d %>% select(user_id, time, cum_pay_scaled) %>% spread(time, cum_pay_scaled) # クラスタリング d.f.km <- kmeans(d.f %>% select(-user_id), centers = 6) d.f$cluster <- d.f.km$cluster # グラフ表示 d.f %>% gather("time", "cum_pay_scaled", `0`:`29`) %>% mutate(time = as.numeric(time)) %>% ggplot(aes( time, cum_pay_scaled, group=as.factor(user_id) )) + geom_line() + facet_wrap(~cluster)
ダミーデータ生成のコード
d <- tibble( user_id = rep(1:500, 30), # ユーザID 500名分 * 30日分 q = rep(abs(rnorm(500, mean = 0, sd = 10)), 30) # 課金確率 500名分 * 30日分 ) %>% mutate( time = trunc((row_number()-1) / 500), # 日付番号の付与 q = q/(max(q) + 0.2) # 0< q <1 になるように調整 ) %>% mutate( pay = map(q, function(q){ # 売上の確率的生成 rbernoulli(1, p=q) * as.numeric(rmultinom(n=1, size=1, prob=c(1/3,1/3,1/3))[1:3,] %*% c(1000, 2000, 3000)) }) %>% as.numeric() )
おわりに
太く短く課金してくれる人と、細く長く課金してくれる人と、どちらが利益への貢献度が高いか？ーーのようなテーマについて考えたとき、今回の分析を思いつきました。
