グラフの集計もようやく終わったので、ここからが楽しいデータ解析とRの時間。
2008年声優言及数 作業メモ（４） データの解析 - XXXannex
2008年声優言及数 作業メモ（４） データの解析 の続き - XXXannex
この辺を参考にしつつ進める・・・のだけど、今読んでもよく分からないなー。ということで、もう少し分かりやすく作り直す。
あと、去年の調査でやった補正はどんなんだっけ。
近似直線から計算した、1月の言及数と12月の言及数の比を取ります。ただし、比がマイナスにならないように、最小値を1にするように補正しています。
同じ「傾き2」でも、言及数100 -> 122 と 言及数1000 -> 1022では元々100だった方が「ブレイク」にふさわしいのでは・・・という考えに基づいています。元々の言及数が少ない人ほど数値が高くなるようにして、より「ブレイク」感が反映されるようにしてみました。
だそうで。コードが残ってないので推測で書いてみる。
## read readpng2r output, and return data frame ## input: ## key name 200801 200802 ... ## output: ## name(rowname) Jan 2008 Feb 2008 ... read.sy.file <- function(filename, pickup=1:12){ # read file l <- read.delim(filename) # 2nd row contains name rownames(l) <- l[,2] # delete escaped-name and name l <- l[,-c(1,2)] # transform "X200801" -> "2008 Jan" n <- colnames(l) colnames(l) <- paste(month.abb[as.integer(substr(n,6,7))], substr(n,2,5)) # pickup data l[pickup] } ## calc linear regression parameter from given data ## input : data frame ## ## Jan 2009 Feb 2009 ## ------------------ ## 2.500 0.000 ## 1397.416 1354.633 ## 0.000 2.010 ## .. ## .. stat.sy <- function(df.sy, pickup=1:12){ # calc lm for each row lm.ba <- apply(l, 1, function(v) lm(count ~ month, data.frame(count=as.numeric(v), month=pickup))$coefficients) # calc last/first rate using regression parameter first.data <- pickup[1] * lm.ba[2,] + lm.ba[1,] last.data <- pickup[length(pickup)] * lm.ba[2,] + lm.ba[1,] shift <- min(first.data) - 1 ## minimun denominator must be 1 # create a new data frame data.frame(sum=apply(l,1,sum), a=lm.ba[2,], b=lm.ba[1,], key=(last.data - shift)/(first.data - shift) ); }
ファイル読み込み用のread.sy.fileと、データ解析用のstat.syに分けます。
> l <- read.sy.file("readpng2r.2008_2009.out", 7:24) > > filename <- "readpng2r.2008_2009.out" > pickup <- 7:24 > l <- read.sy.file(filename, pickup) > l[1:3,1:3] Jul 2008 Aug 2008 Sep 2008 〆野潤子 0.000 0.000 2.000 あきやまかおる 0.000 0.000 0.000 ありす 1282.088 1277.101 1398.781 > > d <- stat.sy(l, pickup) > head(d[sort.list(d$sum, dec=T),], 10) sum a b key ありす 25398.343 10.2434131 1252.2461 1.1266308 水樹奈々 11367.861 25.9785607 228.8801 1.9560382 平野綾 7661.745 -8.2246817 553.1351 0.7442834 久住小春 7620.991 1.4608157 400.7458 1.0537315 田村ゆかり 6188.987 -8.4901266 475.4296 0.6910778 堀江由衣 5480.225 4.5887960 233.3306 1.2463468 中川翔子 4896.718 -2.7648643 314.8953 0.8644497 千秋 4657.553 -0.8762654 272.3350 0.9530692 坂本真綾 4642.954 -6.7772990 362.9900 0.6858617 くじら 4389.564 -0.3702862 249.6041 0.9788923 > head(d[sort.list(d$key, dec=T),], 10) sum a b key 寧々 1504.111 15.738243 -160.381050 268.550136 豊崎愛生 2869.171 15.802849 -85.545777 4.521526 丹下桜 1130.040 8.311239 -66.044205 4.259474 日笠陽子 1045.090 7.775707 -62.462904 4.061274 竹達彩奈 548.030 5.703382 -57.956304 3.922104 福原遥 649.040 5.948373 -56.142010 3.754630 佐藤聡美 1090.600 5.849171 -30.073231 2.601627 寿美菜子 1455.410 6.773788 -24.137600 2.545857 伊藤かな恵 1502.280 5.617358 -3.609019 2.098581
こんなもんでどうっすかね。ざっくりと、こんな感じで出せるのがRのスゲーところ。いじってて楽しすぎる・・・。声優が本職じゃない方も混ざってるので、後は手動でフィルタリングしつつまとめる形で。にしても、水樹奈々はつえー（笑）。今までも平野綾・水樹奈々は別格の言及数だったのだけど、そこからさらに票を伸ばしてくるとは・・・。
若手のけいおん組のその後で一番ぱっとしなかったのは日笠陽子だと思ってたんだけど、そんなことなかったのかー。
・・・っと。まだここで語っちゃダメだ。今はまだ声オタとしてではなく技術者として調査を進めねば・・・。
念のため、http://d.hatena.ne.jp/kkobayashi_a/20090107/p1 で作ったplot.summary.monthを使って全体の傾向を確認してみます。
今年は問題なさそうですね。去年はノイズが多くて大変だったなあ・・・。
