INPUTしたらOUTPUT!

忘れっぽいんでメモっとく

Tokyo.Rの新規率・直帰率について集計・プロットしてみた

第48回 R勉強会@東京のLTにて 「R勉強会の新規率・リピート率ってどうなんだろうね?」 という話があったので確認してみた。

新規率などの定義が間違っていたらご指摘ください。
また実際の出席ベースではなくATNDの登録に基づいているので実態と乖離があります。

<追記>
@hoxo_m氏に添削してもらいました!ありがとうございます!参考になります。


Σ( ̄口 ̄*)
昨年学んだことが身に付いていないですね。。。みどりぼん復習します


1. イベントIDの取得

スクレイピングしなくても出欠確認APIでまとめて取得できるが、希望する形に上手く加工できなかったので イベントのみ抽出し、その後各イベントの出席者を取得する。イベントの取得は以下の通り。

> # イベント取得
> library(dplyr)
> library(rvest)
> doc <- URLencode("http://api.atnd.org/events/?keyword=R勉強会@東京&count=100") %>%
+   read_xml()
> 
> # IDとタイトルのみ抽出
> library(stringr)
> events <- data.frame(
+   event_id = doc %>%
+     xml_nodes(xpath="//events/event/event_id") %>%
+     xml_text() %>%
+     as.numeric(),
+   title = doc %>%
+     xml_nodes(xpath="//events/event/title") %>%
+     xml_text()
+ ) %>%
+   # Tokyo.R女子部, BUGS/stan勉強会を除外
+   filter(str_detect(title, "第[0-9|0-9]+回R勉強会@東京.*")) %>%
+   # イベントIDの降順でソート
+   arrange(-event_id) %>%
+   # 回の列を追加
+   mutate(time = seq(dim(.)[1], 1, -1)) %>%
+   # タイトル列を削除
+   select(event_id, time)
> 
> head(events)
  event_id time
1    68150   49
2    66469   48
3    63990   47
4    61553   46
5    60908   45
6    57640   44
> 


2. 出席者の取得

指定したイベントIDの出席者を取得する関数を作成し、各回の出席者を取得する。 @hoxo_m氏のpforeachパッケージでもっと楽にできそうな気もする。

> # 指定したイベントIDの出席者を取得する関数
> getUsers <- function(x){
+   doc <- paste0("http://api.atnd.org/events/users/?event_id=", x) %>%
+     read_xml() %>%
+     xml_nodes(xpath="//events/event/users/user")
+   
+   users <- data.frame(
+     event_id = rep(x, length(doc)),
+     user_id = doc %>%
+       xml_nodes("user_id") %>%
+       xml_text(),
+     nickname = doc %>%
+       xml_nodes("nickname") %>%
+       xml_text(),
+     twitter_id = doc %>%
+       xml_nodes("twitter_id") %>%
+       xml_text(),
+     status = doc %>%
+       xml_nodes("status") %>%
+       xml_text()
+   )
+   return(users)
+ }
> 
> # 各回の出席者を取得(キャンセル待ちも参加希望として出席とみなす)
> users <- foreach(i=1:length(events$event_id), .combine = rbind) %do% {
+   getUsers(events$event_id[i])
+ }
> 
> head(users)
  event_id user_id       nickname     twitter_id status
1    68150  145711 __john_smith__ __john_smith__      1
2    68150  159246         缶これ    wonder_zone      1
3    68150   21686       kos59125       kos59125      1
4    68150  109170   tom_of_death   tom_of_death      1
5    68150  173679         re_t_s         re_t_s      1
6    68150  166177   YugoKawamura                     1
>


3. 前回出席回、次回出席回、直帰フラグの追加

dplyrパッケージのlag(), lead()を使用して前回出席回、次回出席回を列に追加する。 また前回・次回ともに出席回がNAとなっている場合は直帰(= 一見さん)として区別する。

> users <- users %>%
+   # 回の列を追加
+   inner_join(events, by="event_id") %>%
+   # 前回出席回、次回出席回を追加
+   arrange(user_id, time) %>%
+   group_by(user_id) %>%
+   mutate(last_time = lag(time), next_time = lead(time)) %>%
+   # 直帰フラグを追加
+   rowwise() %>%
+   mutate(bounce = ifelse(is.na(last_time) && is.na(next_time), 1, 0))
> head(users)
Source: local data frame [6 x 9]

  event_id user_id  nickname twitter_id status time last_time next_time bounce
1    30646  102193 quattro_4  quattro_4      1   25        NA        27      0
2    32714  102193 quattro_4  quattro_4      1   27        25        30      0
3    38512  102193 quattro_4  quattro_4      1   30        27        32      0
4    40213  102193 quattro_4  quattro_4      1   32        30        33      0
5    42438  102193 quattro_4  quattro_4      1   33        32        34      0
6    43885  102193 quattro_4  quattro_4      1   34        33        37      0
>


4. 新規率、離脱率、直帰率の算出

回ごとに新規率、離脱率、直帰率を以下のように定義して計算してみる。

  • 新規率 : 新規参加(前回参加回がNA)の数 / 参加者数
  • 離脱率 : 離脱者(次回参加回がNA)の数 / 参加者数
  • 直帰率 : 直帰フラグの合計 / 新規参加者数
> users %>%
+   group_by(time) %>%
+   summarise(n=n(), 
+             new=sum(is.na(last_time)), 
+             exit=sum(is.na(next_time)),
+             bounce=sum(bounce),
+             new.rate=sum(is.na(last_time))/n(), 
+             exit.rate=sum(is.na(next_time))/n(),
+             bounce.rate=sum(bounce)/sum(is.na(last_time))
+             ) %>%
+   arrange(-time) %>%
+   head()
Source: local data frame [6 x 8]

  time   n new exit bounce  new.rate exit.rate bounce.rate
1   49 111  29  111     29 0.2612613 1.0000000   1.0000000
2   48  97  36   60     30 0.3711340 0.6185567   0.8333333
3   47  84  38   45     34 0.4523810 0.5357143   0.8947368
4   46 138  56   68     42 0.4057971 0.4927536   0.7500000
5   45  90  29   35     17 0.3222222 0.3888889   0.5862069
6   44  99  32   47     27 0.3232323 0.4747475   0.8437500
Warning message:
Grouping rowwise data frame strips rowwise nature 
> 


直近20回の直帰率をプロットしてみると次のような感じに。

> users %>%
+   group_by(time) %>%
+   summarise(n=n(), 
+             new=sum(is.na(last_time)), 
+             exit=sum(is.na(next_time)),
+             bounce=sum(bounce),
+             new.rate=sum(is.na(last_time))/n(), 
+             exit.rate=sum(is.na(next_time))/n(),
+             bounce.rate=sum(bounce)/sum(is.na(last_time))
+             ) %>%
+   filter(time > max(time)-20) %>%
+   ggvis(~time, ~bounce.rate) %>%
+   layer_paths()

f:id:tak95:20150714205154p:plain


2,3回空けて参加する方も多いので直近の回の離脱率・直帰率が高くなるのは仕方が無いにしても第40回以降上昇傾向のような気がする。 また47回は初めて参加した38人のうち34人(約90%)が以降参加していない。。。ランダムフォレスト難しかったかな。。。


参考までに新規率もプロットしてみる。

> users %>%
+   group_by(time) %>%
+   summarise(n=n(), 
+             new=sum(is.na(last_time)), 
+             exit=sum(is.na(next_time)),
+             bounce=sum(bounce),
+             new.rate=sum(is.na(last_time))/n(), 
+             exit.rate=sum(is.na(next_time))/n(),
+             bounce.rate=sum(bounce)/sum(is.na(last_time))
+             ) %>%
+   filter(time > max(time)-20) %>%
+   ggvis(~time, ~new.rate) %>%
+   layer_paths()

f:id:tak95:20150714205717p:plain

第47回はむしろ常連が少なく新規増えてきたのかな?と感じてたけど、全体としては下降気味の気が。。。


  • ATNDベースで集計してみたけど実際のところどうなんだろう?