廿TT

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

(googleAnalyticsR) コホート比較で再訪率の高い流入経路を探す

今日の川柳

Google アナリティクスのコホートレポートの分析例です。

高度な使用例  |  アナリティクス Reporting API v4  |  Google Developers

営利目的のサイトだったら、キャンペーン(acquisitionCampaignというディメンション)ごとに再訪率の高さをみるとよさそう。ぼくはキャンペーンやってないので、トラフィックソース(acquisitionSourceというディメンション)でみます。

モデル

 \displaystyle y_{i,k} \sim {\rm Binomial}(N_k, {\rm logit}^{-1}(\beta_k - \alpha_i))
\beta_k \sim {\rm Normal}(0,\sigma)

N_k: 流入経路 k が規準月に獲得した新規ユーザー数
y_{i,k}: 流入経路 k が規準月に獲得した新規ユーザーの内、i月後に再訪問したユーザーの数 ( i=1,2,3)
\alpha_i: 月ごとに異なる切片項。ユーザーの再訪率はだんだんさがるだろうから、今回は  \alpha_1 < \alpha_2 < \alpha_3 という制約をつけていますが、別に制約なしでも(多分)大丈夫です。
 \beta_k: 流入経路 k にかかる係数。ただし  \beta_1 =0 とする。今回の流入経路1は (direct) です。

Stan のコード

data{
  int<lower=1> ncol;
  int<lower=1> nrow;
  int n[ncol];
  int y[nrow,ncol];
}
parameters{
  ordered[nrow] alpha;
  vector[ncol-1] beta0;
  real<lower=0> sigma;
}
transformed parameters{
  vector[ncol] beta;
  beta = append_row(0,beta0);
}
model{
  for(i in 1:nrow){
    for(j in 1:ncol){
      y[i,j] ~ binomial_logit(n[j],-alpha[i]+beta[j]);
    }
  }
  beta0 ~ normal(0,sigma);
}
generated quantities{
  real oddsratio[ncol-1];
  real baseprob[nrow];
  for(j in 1:(ncol-1)){
    oddsratio[j] = exp(beta0[j]);
  }
  for(i in 1:nrow){
   baseprob[i] = inv_logit(-alpha[i]); 
  }
}

結果

ベースラインとなる再訪率とその95%信用区間の図です。

f:id:abrahamcow:20180422234736p:plain

トラフィックソースごとの再訪率のオッズ比とその95%信用区間です。

f:id:abrahamcow:20180422235102p:plain

t.co(ツイッター)がずば抜けていますね。

あとヤフーが低いのにGoogleがちょっと高い。

R のコード

library(googleAnalyticsR)
library(tidyverse)
library(rstan)
rstan_options(auto_write = TRUE)
#####
ga_auth()
account_list <- ga_account_list()
ga_id <- account_list$viewId[3]


cohort_month <- make_cohort_group(list("cohort1" = c("2018-01-01","2018-01-31")))

gadata_monthly <-
  google_analytics(ga_id,
                   cohorts = cohort_month,
                   metrics = c("cohortActiveUsers"),
                   dimensions = c("cohort","cohortNthMonth","acquisitionMedium","acquisitionSource"))


gadata_monthly_s <- gadata_monthly %>% 
  dplyr::select(-acquisitionMedium) %>% 
  spread(acquisitionSource,cohortActiveUsers,fill = 0)

mod_cohort <-stan_model("cohort.stan")

ldat <- list(ncol = ncol(gadata_monthly_s[-1,-c(1:2)]),
             nrow = nrow(gadata_monthly_s[-1,-c(1:2)]),
             y = gadata_monthly_s[-1,-c(1:2)],
             n = as.integer(gadata_monthly_s[1,-c(1:2)]))

smp_cohort <-sampling(mod_cohort, ldat)
print(all(summary(smp_cohort)$summary[,"Rhat"]<1.1,na.rm = TRUE))

baseprob_df <-data_frame(
  p=get_posterior_mean(smp_cohort,pars="baseprob")[,"mean-all chains"],
  lower=summary(smp_cohort,pars="baseprob")$summary[,"2.5%"],
  upper=summary(smp_cohort,pars="baseprob")$summary[,"97.5%"]) %>% 
  mutate(month=1:3)

p_base <-ggplot(baseprob_df,aes(x=month,y=p,ymin=lower,ymax=upper))+
  geom_point()+
  geom_line()+
  geom_ribbon(alpha=0.3)+
  theme_bw()

ggsave("p_base.png",p_base)

mediumtable <-gadata_monthly %>% 
  dplyr::select(acquisitionSource,acquisitionMedium) %>% 
  distinct()

oddsratio_df <-data_frame(
  oddsratio=get_posterior_mean(smp_cohort,pars="oddsratio")[,"mean-all chains"],
  lower=summary(smp_cohort,pars="oddsratio")$summary[,"2.5%"],
  upper=summary(smp_cohort,pars="oddsratio")$summary[,"97.5%"]) %>% 
  mutate(acquisitionSource=colnames(ldat$y)[-1]) %>% 
  left_join(mediumtable,by="acquisitionSource")

p_oddsratio <-ggplot(oddsratio_df,aes(x=reorder(acquisitionSource,oddsratio),y=oddsratio,ymin=lower,ymax=upper,colour=acquisitionMedium))+
  geom_pointrange()+
  coord_flip()+
  geom_hline(yintercept = 1,linetype=2)+
  theme_bw()+
  xlab("acquisitionSource")

ggsave("p_oddsratio.png",p_oddsratio,height = 10)