【R Advent Calendar 2014】Rでスクフェス #RAdventJP
はじめに
R Advent Calendar 2014 15日目の記事です。
初めてのAdvent Calendarです。よろしくお願いします。
きっかけ
突然ですが、私はかつてスクフェスにはまっていました。スクフェスとは、「ラブライブ!スクールアイドルフェスティバル」の略で、スマホ向けの音楽ゲームです。
かつてはまっていたスクフェスをなぜやめたかと言うと、明らかにユーザーが増えてイベントのランキングに食い込めない気がしなかったためです。
ほんとにユーザーが増えたことでランキングの上位に食い込むのは難しいのでしょうか?ユーザーは何らかの傾向に従っているのでしょうか?
分析してみました。
使った手法
独立変数を与えた際に、各群の比率について、線形傾向があるか否かを分析する手法としてコクラン・アミテージ(Cochran-Armitage)の傾向検定というものがあります。
コクラン・アミテージの傾向検定は本来、生物統計の分野において、下記の表のような分割表における各群のイベント数とケース数(各群における全体の数)の比について、線形か否かの検定を行うものです。
例えば、ケース数は薬剤を投与した人数、イベント数はその中で死んでしまった人数です。左から右へ投与量が増加していると仮定したらわかりやすいでしょうか。
群 | 1 | 2 | 3 |
---|---|---|---|
イベント数 | 10 | 12 | 5 |
ケース数 | 23 | 30 | 40 |
詳しい数理的な背景については、こちらやこちらを参照してください。
さて、今回は、イベント数として、「2枚SRがとれた」、ケース数として「1枚はSRがとれた」と定義し、1枚はSRがとれたけど、2枚取れた人は~という事柄について線形か否かの分析を行います。
ちなみにSRとは、ゲーム内に登場するキャラクターのレアについてのランクです。 UR>SR>R>Nという順になっております。
1枚はSRがとれた(以下、1枚取りと表記します)は予め決められたスコアを超えたら獲得できるのに対し、2枚SRがとれた(2枚取りと表記します)は、最終結果で決められた順位に入らないと獲得できません。
スクフェスは年々ユーザーが増加しており、現在では600万人を突破したそうです。スクフェス内でのイベントがあればそれも同様に参加人数が多く、一定のスコアを獲得すればなれる1枚取りに対し、順位で決められる2枚取り獲得する人数がほとんど変動しないため、1枚取りと2枚取りの間で人数が増加しているのではないかと考えました。
Rにおいては、prop.trend.testでできます。
四の五の言わずに実行
データなどについては下記のリンク(github)にあります。ここでは、ソースコードだけ記載します。
library(dplyr) #Data story <- read.csv("storyevent.csv") scorematch <- read.csv("scorematchevent.csv") temp <- merge(story, scorematch, all=T) temp <- data.frame(temp, start=as.Date(temp$startdate)) scfesall <-arrange(temp, start) #Cochran-Armitage scfes <- scfesall %>% select(userd, get1, start) %>% subset(!is.na(get1)) colnames(scfes) <- c("double", "all", "start") prop.trend.test(scfes$double, scfes$all, scfes$start) #Cochran-Armitage taso <- scfesall %>% filter(character=="kotori") %>% select(userd, get1, start) colnames(taso) <- c("double", "all", "start") prop.trend.test(taso$double, taso$all, taso$start)
dplyrでデータを整理し、2枚取り(double)、1枚取り(all)、群を示すイベント開始日(start)で抽出したデータをつくります。密かに欠損値は除外しています。そしてprop.trend.testを実行します。
ちなみに、下にあるtasoというのは、獲得できるSRがことりちゃんの場合のみで行った結果です。なぜことりちゃんですって?そりゃ・・・(以下略)。
> prop.trend.test(scfes$double, scfes$all, scfes$start) Chi-squared Test for Trend in Proportions data: scfes$double out of scfes$all , using scores: 2013-05-03 2013-05-21 2013-06-12 2013-06-28 2013-07-08 2013-07-19 2013-08-05 2013-08-20 2013-10-05 2013-10-20 2013-11-05 2013-11-20 2013-12-05 2013-12-20 2014-01-05 2014-01-20 2014-02-05 2014-02-20 2014-03-05 2014-03-20 2014-04-05 2014-04-20 2014-05-05 2014-05-20 2014-06-05 2014-06-20 2014-07-05 2014-07-20 2014-08-05 2014-08-20 2014-09-05 2014-09-20 2014-10-05 2014-10-20 2014-11-05 2014-11-20 X-squared = 10269.5, df = 1, p-value < 2.2e-16
この結果より、P値が0.00000000000000022以下と極めて小さい数であるため、線形傾向がないという帰無仮説は棄却されました。
また、ことりちゃんのみで行った際も
> prop.trend.test(taso$double, taso$all, taso$start) Chi-squared Test for Trend in Proportions data: taso$double out of taso$all , using scores: 2013-05-03 2013-06-28 2013-11-05 2014-03-20 2014-07-20 X-squared = 59.1122, df = 1, p-value = 1.489e-14
となり、帰無仮説は棄却されました(P値=0.00000000000001489)。
プロットしてみた
なんかこのまま終わるとしょうもないので、先ほどの割合についてプロットしてみました。
library(ggplot2) scfes2 <- mutate(scfes, double, all, start, rate=double/all) taso2 <- mutate(taso, double, all, start, rate=double/all) graph1 <- ggplot(scfes2, aes(x=start, y=rate)) graph1 + geom_line() ggsave("graph1.png") graph2 <- ggplot(taso2, aes(x=start, y=rate)) graph2 + geom_line() ggsave("graph2.png")
結果は次の通り。
まず、全体の結果。
次にことりちゃん。
・・・。
なんだこれは・・・。
一体何があったのだ・・・初期の頃(=私がドはまりしていた頃)。
というかこの結果って・・・。
さて、明日のR Advent Calendarはfloretsさんです。ツイートを拝見させていただいたところ、私の地元・関西の方みたいですね!