Tokyo.Rの新規率・直帰率について集計・プロットしてみた
第48回 R勉強会@東京のLTにて 「R勉強会の新規率・リピート率ってどうなんだろうね?」 という話があったので確認してみた。
新規率などの定義が間違っていたらご指摘ください。
また実際の出席ベースではなくATNDの登録に基づいているので実態と乖離があります。
<追記>
@hoxo_m氏に添削してもらいました!ありがとうございます!参考になります。
Tokyo.Rの新規率・直帰率について集計、久保本の読者なら率じゃなくて人数で二項分布やろー
— MatsuuraKentaro (@berobero11) 2015, 7月 17
Σ( ̄口 ̄*)
昨年学んだことが身に付いていないですね。。。みどりぼん復習します
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()
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()
第47回はむしろ常連が少なく新規増えてきたのかな?と感じてたけど、全体としては下降気味の気が。。。
- ATNDベースで集計してみたけど実際のところどうなんだろう?