タイトルって難しい。

学力も体力もない人間の雑記帳。

スクフェスのタイマーをつくりたい(Rでスクフェス第2回)

こんばんは、今年もあとわずか。みなさんいかがお過ごしでしょうか。私は、今実家に帰ってきております。

この話はRでスクフェスシリーズの第2回です。
前回は~枚取りの割合に対する線形傾向の有無を調べました。今回は、ちょっとぶっとんで、実際にプレイする人向けに通知する手段はないか考えてみました。

なにがしたいのか?

やりたいことは1つ。スクフェスのタイマーを実装したい。しかもRで。
いやPHPなりPythonなりでやりなさいよって全くその通りなんですけど。

実装するにあたっての流れ&やったこと

実装するにあたり、簡単な流れを書き出します。

1.RankからLPを算出
2.LP全回復を前提とした回復までの時間計算
3.計算した時間後に通知

RankからLP算出については、規則があるみたいなので、それに従って書いてみました。

LPcalc <- function(x){
  # x is the rank
  if (x <300){
    if (x %% 2 != 0){
      x = x - 1
    }
    LP = x / 2 + 25
  }
  else{
    x = x - 300
    if( x %% 3 == 1){
      x = x - 1
    }
    else if( x %% 3 == 2){
      x = x - 2
    }
    LP = x / 3 + 175
  }
  return (LP)
}

上記のソースは、rankからLPを算出する関数です。

次に全回復するまでの時間計算です。

cureTime <- function(x){
  # x is the LP
  time = x * 6
  hour = time %/% 60
  min = time - hour * 60
  timesec = x * 360
  #cat(hour,"時間", min, "分後です \n")
  return(timesec)
}

上記ソース内下部のコメントアウトを解除すると何時間何分後っていうのが出力されます。
さて、これらを複合すると以下のようになりますね。

SCFEStimer <- function(n){
  x = LPcalc(n)
  t = cureTime(x)
  #func_notification(t)
}

func_notificationにあたるなにかが必要なのです。さてどうしましょうか・・・。

Rで通知するに当たって有用な資料として、dichika大先生のスライドがあります。
この中で、作成されたYoを用いた通知を行うパッケージの話があり、自身の垢に関するAPIを取得すると飛ばせるそうです。(参照)
こちらを承諾いただいたうえで読み込みかけるか、はたまた違う方法を用いるか。悩みどころですね・・・。
他にも意見がありましたら是非よろしくお願いします。パッケージにしてしまおうかと今考えているところです。

【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")

結果は次の通り。
まず、全体の結果。

f:id:cancolle:20141212003756p:plain

次にことりちゃん。

f:id:cancolle:20141212002607p:plain

・・・。
なんだこれは・・・。
一体何があったのだ・・・初期の頃(=私がドはまりしていた頃)。 というかこの結果って・・・。

さて、明日のR Advent Calendarはfloretsさんです。ツイートを拝見させていただいたところ、私の地元・関西の方みたいですね!