2008年声優言及数 作業メモ(4) データの解析

ようやく解析。ここからが楽しいRの時間ですね。

まずはデータの概要を眺める。

# input file format: key name 200601  200602  200603 ....
read.sy.data <- function(file){
    d <- read.delim(file)
    n <- colnames(d)
    # make colnames: X200812 -> Dec 2008
    colnames(d)[-(1:2)] <- paste(month.abb[as.integer(substr(n,6,7))], substr(n,2,5))[-(1:2)]
    # make rownames: URI-escaped name
    rownames(d) <- as.character(d[,1])
    d[,-1]
}

こんな感じのスクリプトで、データを取得してきます。取得したデータのうち、さらに後ろ18ヶ月(12ヶ月+6ヶ月)分のデータをサンプリングします。

> d  <- read.sy.data("2008_sy.txt")
> d1 <- d[,rev(seq(ncol(d), by=-1, length=18))]
> summary(d1)
    Jan 2008          Feb 2008          Mar 2008          Apr 2008          May 2008      
 Min.   :   0.00   Min.   :   0.00   Min.   :   0.00   Min.   :   0.00   Min.   :   0.00  
 1st Qu.:   0.00   1st Qu.:   0.00   1st Qu.:   0.00   1st Qu.:   0.00   1st Qu.:   0.00  
 Median :   5.47   Median :   3.94   Median :   4.00   Median :   3.98   Median :   4.00  
 Mean   :  46.24   Mean   :  21.68   Mean   :  25.60   Mean   :  23.14   Mean   :  21.65  
 3rd Qu.:  23.28   3rd Qu.:  14.80   3rd Qu.:  18.84   3rd Qu.:  16.24   3rd Qu.:  15.00  
 Max.   :1785.78   Max.   :1418.99   Max.   :1434.58   Max.   :1353.62   Max.   :1348.74  
    Jun 2008          Jul 2008           Aug 2008           Sep 2008          Oct 2008      
 Min.   :   0.00   Min.   :   0.000   Min.   :   0.000   Min.   :   0.00   Min.   :   0.00  
 1st Qu.:   0.00   1st Qu.:   0.000   1st Qu.:   0.000   1st Qu.:   0.00   1st Qu.:   0.00  
 Median :   5.96   Median :   4.161   Median :   2.147   Median :   2.12   Median :   2.00  
 Mean   :  43.03   Mean   :  23.144   Mean   :  19.498   Mean   :  19.03   Mean   :  21.66  
 3rd Qu.:  26.19   3rd Qu.:  20.063   3rd Qu.:  14.618   3rd Qu.:  12.07   3rd Qu.:  13.84  
 Max.   :1309.94   Max.   :1273.256   Max.   :1268.291   Max.   :1389.15   Max.   :1427.70  
    Nov 2008           Dec 2008      
 Min.   :   0.000   Min.   :   0.00  
 1st Qu.:   0.000   1st Qu.:   0.00  
 Median :   2.743   Median :   2.98  
 Mean   :  19.465   Mean   :  20.66  
 3rd Qu.:  14.567   3rd Qu.:  15.28  
 Max.   :1305.260   Max.   :1424.43  

summary()はお手軽に4分点を見ることができて便利です。
せっかくなのでグラフに出してみます。

plot.summary.month <- function(d, pickup=1:ncol(d), len=5){
    d <- d[,pickup]
    m <- apply(d, 2, quantile, probs=seq(0.5, 1, length=len))
    n <- nrow(m)

    # create palette
    plt <- rgb(colorRamp(c("blue", "white"))(seq(0.7, 0, length=n)), max=255)
    # plot box
    plot(pickup, log(m[n,]), xaxt="n", ann=F, type="n", ylim=c(0, log(max(m))))
    # plot lines
    for(i in 1:n) lines(pickup, log(m[i,]), lwd=2, col=plt[i])
    # write labels
    axis(1, pickup, substr(colnames(m), 1, 3))
}

こんな感じの関数を作って実行します。

> plot.summary.month(d1, len=3)

上の関数では、0からではなく0.5からの分割点を取っているので、3の場合は0.5、0.75、1.0の3つになります。y軸は対数にした方が綺麗に見えるようです。
分割点をもっと増やしてみると面白いのでやってみます。

> plot.summary.month(d1, len=50)

1月と6月に山があります。これは何が原因なのでしょう。

cond <- apply(d, 1, function(x){
    threshold <- 1.5
    (x[1] > mean(x)*threshold && x[6] > mean(x)*threshold)
              })
d[cond,]
                                       Jan 2008    Feb 2008   Mar 2008    Apr 2008   May 2008   Jun 2008   Jul 2008    Aug 2008    Sep 2008   Oct 2008  Nov 2008    Dec 2008
%A4%A4%A4%CE%A4%AF%A4%C1%A4%E6%A4%AB  69.373798  25.6294809  29.866257  20.7271585  18.753525 164.975738  39.204044  31.8566667  28.8378689  31.083798 35.151667 42.24000000
%A4%B3%A4%B8%A4%DE%A4%AB%A4%BA%A4%B3  12.330000   3.9200000   6.688634   3.1913661   7.335301  23.561311  22.223388   1.9600000   0.0000000   1.960000  0.000000  0.00000000
%A4%D2%A4%C8%C8%FE                    34.384699  21.8339891  17.320656   3.8006557   8.190601  36.728087  30.941311  11.8800000   6.8800000   4.753333  4.566667  0.00000000
%B0%A4%B5%D7%C4%C5%B2%C3%BA%DA        20.740000  14.8000000  23.359344   8.2806557   1.895301  21.401967  15.782732   5.8800000   8.4000000  12.720000 10.000000  1.96000000
%B0%C2%B6%EA%BF%BC%B2%BB              28.864699  21.1653005   5.039344  19.1606557  11.800000  39.707268  28.574044  14.4186885  14.6793443  12.233989 16.926011 14.84065574
%B0%CB%C1%D2%B0%EC%B7%C3              20.260956  29.9829781  13.735410   0.3606557   9.974645  34.242623  26.422732   4.0000000   1.9600000   3.920000  0.000000  5.92000000
%B0%CB%C5%EC%B5%D7%C8%FE%BB%D2         7.960000   7.9600000   0.000000   0.0000000   0.000000   3.980000   0.000000   0.0000000   0.0000000   0.000000  0.000000  0.00000000
%B1%CA%B0%E6%BF%BF%B0%E1               9.400000   0.0000000   7.890000   5.8800000   2.855301  18.761967  14.782732   1.8000000   2.1200000   3.920000  1.960000  1.96000000
%B1%CA%B8%AB%A4%CF%A4%EB%A4%AB         3.480000   1.9900000   3.980000   0.0000000   0.000000   1.990000   0.000000   0.0000000   0.0000000   0.000000  0.000000  0.00000000
%B2%AC%C5%C4%CD%A5%B9%E1              12.553005   3.3469945   0.000000   4.0000000   2.000000   4.000000   0.000000   0.0000000   2.0000000   2.000000  0.000000  2.00000000
%B2%C3%C6%A3%C6%E0%A1%B9%B3%A8        28.450000  17.4600000  30.678443   5.9815574   9.373443  30.813443  29.113115   3.3800000  14.5500000  14.140000 14.160000  8.21000000
%B2%D6%C2%BC%CE%E7%C8%FE             101.039372  27.7363661  25.114262  25.6674044  33.143798 154.610929  60.284508  33.7633607  14.6035519  17.349781  9.906667 18.09000000
%B2%D6%DF%B7%B9%E1%BA%DA             213.649372  55.2601366  78.934180 116.8138798 112.168279 239.044590 151.180874 105.0020219 155.4862842 108.738716 76.232295 81.03937158
...
...

%B2%D6%C2%BC%CE%E7%C8%FE = 花村怜美あたりが顕著ですね。6月に山があった理由はこちらの通り。

で、1月の山はいったい何?

どうやら1月の10日前後に山があるみたいですね。

含むブログを見てみると、6月分の言及は「女性声優140人ソート」の影響なのが一目で分かるけど、1月分の言及は分からないな。1月はスパムかなあ・・・。でも、アニメ改変期の1月の言及が取れないってのは結構痛いかも。

> plot.summary.month(d1, seq(ncol(d1))[c(-7,-12)], len=50)

試しに1月と6月を除いてみると、だいぶ安定した感じになっているようです。


参考:1月と6月を除く前

参考2:6,7,8,12,1,6月を除いた場合
2007年はスパムの被害がすごすぎる。cf.「2007年6月〜8月、はてなの言及数がおかしくなってる件について」の検索結果 - XXXannex

余談ですが

Rでグラフを出力されるときはPDF形式にするとアンチエイリアスとかかかってきれい。その後Imagemagickとかで

$ mogrify -format png -resize 75% -trim *.pdf

こんな感じでPNGに変換する。