廿TT

譬如水怙牛過窓櫺 頭角四蹄都過了 因甚麼尾巴過不得

[googleAnalyticsR]非負値行列因子分解を用いたユーザーと閲覧ページのクラスタリング(とレコメンド)

今日の川柳

非負値行列因子分解(非負値行列因子分解をRで(ベイズ推論による機械学習入門) - 廿TT)でもう少し遊んでみる.

メインの関数は Non-negative matrix factorization · GitHub に上げました.

非負値行列因子分解は情報推薦にも応用できる(Rによるレコメンドの簡単な例 - ZeeMaのブログ).

グーグルアナリティクスのデーターでそれをちょっとやってみたい.

まずは googleAnalyticsR でデータをとってくる.

library(googleAnalyticsR)
library(tidyverse)
source("https://gist.githubusercontent.com/abikoushi/4a3c6b6de001c889515aabcb1a30e9d4/raw/bee15003e4855c4ab12a60098759ca1a3182f87f/NMF.R")
#####
ga_auth()
account_list <- ga_account_list()
ga_id <- account_list$viewId[3]

gadata <-
  google_analytics_4(ga_id,
                     date_range = c("2017-12-01","2017-12-31"),
                     metrics = c("pageviews"),
                     dimensions = c("userBucket","pageTitle"),
                     max = 10000)

userBucket というディメンションは耳慣れないかもしれないが, これはユーザーを1から100のグループにランダムに振り分けたもので, グーグルではこれをリマーケティングのABテストなんかに使うことを推奨している.

列持ちのデータを行列形式に変えて自作関数NMFに放り込む.

gamat <-spread(gadata2, pageTitle, pageviews,fill=0)
res3 <-NMF(gamat[,-1],M=3)

さて結果を見てみよう.

行列 H は行が文書の潜在的なトピックを表し, 各列がトピックが与えられたときにそのページが閲覧される「強さ」を表すと解釈できる.

H の各行で値の大きい順に10タイトルを抽出し眺めてみる.

> title <-colnames(gamat[,-1])
> title[order(res3$H[1,],decreasing = TRUE)][1:10]
 [1] "A/Bテストのガイドライン:仮説検定はいらない(Request for Comments|ご意見求む) - 廿TT"
 [2] "A/Bテスト、多変量テストのための「効果量」入門 - 廿TT"                                  
 [3] "廿TT"                                                                                  
 [4] "A/Bテスト、多変量テストに必要な期間を見積もる方法の紹介 - 廿TT"                        
 [5] "ズバリ! 必要なサンプルサイズはいくつ? A/Bテストのための例数設計入門 - 廿TT"          
 [6] "「A/Bテストの数理」への批判:「有意」とはなにか - 廿TT"                                
 [7] "A/Bテスト、多変量テストの図示 - 廿TT"                                                  
 [8] "A/Bテスト カテゴリーの記事一覧 - 廿TT"                                                 
 [9] "ポリシー カテゴリーの記事一覧 - 廿TT"                                                  
[10] "検定いらずの AB テスト:φ 係数を用いたサンプルサイズ設計 - 廿TT" 
                     
> title[order(res3$H[2,],decreasing = TRUE)][1:10]
 [1] "R でシミュレーションする格子の上の SIR モデル - 廿TT"                              
 [2] "R カテゴリーの記事一覧 - 廿TT"                                                     
 [3] "Laslett (1982) の尤度関数とワイブル分布を仮定した最尤推定のシミュレーション - 廿TT"
 [4] "ggplot2 で接線場や方向場を描く - 廿TT"                                             
 [5] "ワイブル分布のパラメータ推定(Stan vs survreg) - 廿TT"                            
 [6] "R カテゴリーの記事一覧 3ページ目 - 廿TT"                                           
 [7] "R カテゴリーの記事一覧 5ページ目 - 廿TT"                                           
 [8] "R カテゴリーの記事一覧 2ページ目 - 廿TT"                                           
 [9] "ロトカ・ヴォルテラの方程式のパラメータ推定 - 廿TT"                                 
[10] "不完全データ カテゴリーの記事一覧 - 廿TT"
                                          
> title[order(res3$H[3,],decreasing = TRUE)][1:10]
 [1] "花合わせの遊び方:よい子とよい大人のための花札入門 - 廿TT"                                                        
 [2] "指数近似、対数近似曲線の導出と近似曲線の選び方 - 廿TT"                                                            
 [3] "原点がゼロでないグラフ、2軸のグラフ - 廿TT"                                                                      
 [4] "(ネタバレ)新井英樹『ザ・ワールド・イズ・マイン』のあらすじ - 廿TT"                                              
 [5] "昔はヤンチャもしたけど今は育ててくれた親にマジ感謝系日本語ラップの歌詞解説:ドレミの歌としてのヒップホップ - 廿TT"
 [6] "ニュートンの冷却の法則を大雑把に理解した - 廿TT"                                                                  
 [7] "Excel でワイブルプロット - 廿TT"                                                                                  
 [8] "Google トレンドの縦軸の数字(検索インタレスト)ってなんなの? - 廿TT"                                             
 [9] "割れ窓理論にまつわるうわさを整理しよう。そして見えざる権力を見える化しよう。 - 廿TT"                              
[10] "時系列データの相関係数はあてにならない……のか? 教えて下さい - 廿TT"                                             

トピック1は明らかにABテスト関連のエントリが集中している.

トピック2はRカテゴリのエントリ, それも割とマニアックなものが集まった.

トピック3は数式とかコードが出てこない一般向け(っていうか)のエントリと解釈できる.

Wの値は行ごとに足して1になるように正規化してやって, userBucket ごとの各トピック成分の構成比と解釈する.

normW <-sweep(res3$W,1,apply(res3$W,1,sum),"/")
normW_df <-as_data_frame(normW) %>% 
  mutate(userBucket=row_number()) %>% 
  gather(topic,value,-userBucket) %>% 
  mutate(topic=sub("V","",topic))

p1 <-ggplot(normW_df,aes(x=topic,y=value,fill=topic))+
  geom_col()+
  facet_wrap(~userBucket)+
  theme(strip.background = element_blank(),
        strip.text.x = element_blank())
print(p1)

f:id:abrahamcow:20180103205106p:plain

ほとんどすべての userBucket でトピック3が支配的になってしまった.

まあランダムサンプリングしているから当たり前か.

でもこんな感じのことを何重にもディメンション区切ってやってみたらおもしろいことがありそうな気がする.

WH の値からレコメンドするページを見つけることもできる.

各 userBucket ごとに WH の値, 上位3ページを抜き出すにはこんなふうにする.

t(apply(res3$W%*%res3$H,1,function(x)title[order(x,decreasing = TRUE)][1:3]))

今回は全 userBucket で同じページが推薦されてしまい, おもしろくないので結果は割愛する.

この文を書くにあたっては
https://www.jstage.jst.go.jp/article/jscswabun/28/1/28_41/_pdf
を参考にした.