廿TT

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

混合ロジスティック回帰を用いた検索クエリのクラスタリング(flexmix 版)

[rstan]混合ロジスティック回帰を用いた検索キーワードのクラスタリング - 廿TT というエントリを書いたんだけど、実務で使うには Stan はちょっとハードル高いかなーと思って R のパッケージを探したら flexmix というのがあった。

これで簡単にクラスタリングができる。

分析対象とするランディングページは、指数近似、対数近似曲線の導出と近似曲線の選び方 - 廿TT

横軸にインプレッション、縦軸にクリック数をとった検索クエリの散布図は以下。

f:id:abrahamcow:20170727034607p:plain

当前インプレッションが増えるとクリックが増えるという関係が伺える。

ただし、傾きの違う線形の関係がふたつ混じっているように見える。

傾きが大きいほうがクリック率が高くて効率のよいキーワード、傾きの小さいほうが効率の悪いキーワードだと考えられる。

これを混合二項分布のロジスティック回帰でクラスタリングする。

ふたつの二項分布で掲載順位にかかる係数は共通とし、切片項が異なると仮定する。

クラスタごとのクリック率(ctr)への当てはめプロットは以下。

f:id:abrahamcow:20170727034701p:plain

f:id:abrahamcow:20170727034717p:plain

クラスタで色分けして再度プロットしてみると、下図のようになる。

f:id:abrahamcow:20170727034637p:plain

各クエリのクリック数をクラスタごとに棒グラフにしてみる。

効率のよいクラスタ 1 は以下のようなキーワード(クリック数上位20)

f:id:abrahamcow:20170727034803p:plain

効率のわるいクラスタ 2 は以下のようなキーワード(クリック数上位20)

f:id:abrahamcow:20170727034816p:plain

今回はキーワードを眺めてもあまり上手い解釈が見つけらなかった。

なにかクラスタごとにクエリの共通点を見いだせる方がいたら教えてください。

以下に R のコードを貼る。

library(flexmix)
library(dplyr)
library(cowplot)
library(searchConsoleR)
theme_set(theme_cowplot(font_family = "HiraKakuProN-W3"))
#######
#デフォルトでは、90日分のデータをとってくる
scr_auth()
sc_websites <- list_websites()

scdata <- search_analytics(sc_websites[1,1], 
                           dimensions = c("query"),
                           dimensionFilterExp = 
                             "page==http://abrahamcow.hatenablog.com/entry/2014/12/19/221230",
                           rowLimit = 20000)

scdata <- scdata %>% 
  dplyr::filter(!is.na(query))
#######
p1 <- ggplot(scdata,aes(x=impressions,y=clicks,colour=position))+
  geom_point(size=3)
print(p1)

#######
set.seed(1)
fit1 <- flexmix(cbind(clicks, impressions - clicks) ~ 1,
                data = scdata, k = 2,
                model = FLXMRglmfix(family = "binomial",
                                    fixed = ~ position))
cl1 <-clusters(fit1)
#######

p2 <- ggplot(scdata,aes(x=impressions,y=clicks,colour=factor(cl1)))+
  geom_point(size=3,alpha=0.7)+
  theme(legend.title = element_blank())
print(p2)

p3_1 <- ggplot(scdata[cl1==1,],aes(x=position,y=ctr,size=impressions))+
  geom_point(alpha=0.7)+
  stat_function(fun=function(x){
    plogis(parameters(fit1)[2,1]+parameters(fit1)[1,1]*x)
    },size=1,colour="royalblue")+
  ylim(c(0,1))

p3_2 <- ggplot(scdata[cl1==2,],aes(x=position,y=ctr,size=impressions))+
  geom_point(alpha=0.7)+
  stat_function(fun=function(x){
    plogis(parameters(fit1)[2,2]+parameters(fit1)[1,2]*x)
  },size=1,colour="royalblue")+
  ylim(c(0,1))

print(p3_1)
print(p3_2)

p4_1 <- ggplot(head(scdata[cl1==1,],20),aes(x=reorder(query,clicks),y=clicks))+
  geom_col()+
  xlab("")+
  coord_flip()

p4_2 <- ggplot(head(scdata[cl1==2,],20),aes(x=reorder(query,clicks),y=clicks))+
  geom_col()+
  xlab("")+
  coord_flip()

print(p4_1)
print(p4_2)