知り合いの研究者「君って統計得意らしいね!!PCAやりたいんだけど君できるかな!?!?」
オレ「（パラクロロアンフェタミン Para-chloroamphetamine…何言ってんだk(ry」
と思って帰って調べたら主成分分析のことでした。
直交回転を用いて変数間に相関がある元の観測値を、相関の無い主成分とよばれる値に変換するための数学的な手続き…
ってこまけえことはいいんだよ!!って感じでいつものようにやってみる。
ひとまずぐぐると、R苦手の会とか主成分分析が簡単にできるサイトを作ったとかいうのが引っかかったのだが、その中で隠れたトレンドを探る：多変量解析というが参考になりそうなのでこれをパクる。
私はもともとサッカー小僧だったので、シュートと得点とかアシストとかパス回しとかそういうデータが欲しかったのだが、見つからなかったのでさっきのサイトをパクってスポーツ報知から取ってくることにした。
これをコピペ→テキストエディタに貼ってセーブ。
data0 <- read.delim("baseball.txt", header=TRUE)
順位 選手名 所属 打率 試合数 打席 打数 得点 安打 二塁打 三塁打 本塁打 打点 長打率 三振 四球 死球 犠打 犠飛 盗塁 出塁率 1 阿部慎之助 巨 .340 138 556 467 72 159 22 1 27 104 .565 47 69 9 2 8 0 .429 2 坂本勇人 巨 .311 144 619 557 87 173 35 2 14 69 .456 90 39 6 12 5 16 .359 3 大島洋平 中 .310 144 631 555 83 172 19 5 1 13 .368 80 46 13 17 0 32 .376 4 長野久義 巨 .301 144 653 574 84 173 29 2 14 60 .432 100 75 1 2 1 20 .382 5 ミレッジ ヤ .30042 125 546 476 73 143 23 1 21 65 .485 79 57 6 3 4 9 .379 5 ラミレス Ｄ .30042 137 504 476 40 143 25 0 19 76 .473 60 18 7 0 3 0 .333 7 川端慎吾 ヤ .298 125 507 453 52 135 15 5 4 49 .380 56 35 2 13 4 3 .348 8 和田一浩 中 .285 144 586 508 52 145 32 2 9 63 .409 72 71 1 0 6 2 .370 9 井端弘和 中 .284 140 553 489 35 139 17 0 2 35 .331 58 52 3 8 1 4 .356 10 中村紀洋 Ｄ .27376 126 500 442 50 121 24 1 11 61 .407 72 50 2 0 6 1 .346 11 田中浩康 ヤ .27366 139 593 486 48 133 16 1 2 40 .323 60 54 9 40 4 1 .354 12 荒波翔 Ｄ .268 141 550 504 53 135 16 7 1 25 .333 90 23 5 16 2 24 .305 13 畠山和洋 ヤ .266 121 497 455 49 121 21 1 13 55 .402 64 37 2 1 2 2 .323 14 鳥谷敬 神 .262 144 624 515 62 135 22 6 8 59 .375 91 94 2 5 8 15 .373 15 マートン 神 .260 121 473 453 39 118 18 2 5 38 .342 56 18 1 0 1 2 .290 16 村田修一 巨 .252 144 575 516 49 130 27 0 12 58 .374 85 36 15 2 6 1 .316 17 荒木雅博 中 .251 129 569 510 50 128 21 1 3 31 .314 65 19 2 36 2 12 .280 18 新井貴浩 神 .250 122 493 460 46 115 25 0 9 52 .363 85 30 1 0 2 1 .296 19 森野将彦 中 .249 124 494 434 45 108 23 1 6 50 .348 68 49 3 4 4 1 .327 20 平野恵一 神 .245 134 519 458 43 112 5 2 1 24 .271 61 42 4 15 0 6 .313 21 梵英心 広 .244 137 575 499 52 122 21 3 10 52 .359 70 50 1 19 6 14 .311 22 堂林翔太 広 .242 144 554 488 60 118 25 4 14 45 .395 150 44 14 5 3 5 .321 23 谷繁元信 中 .228 134 458 386 15 88 14 0 5 32 .303 67 52 4 14 2 0 .324 24 筒香嘉智 Ｄ .218 108 446 386 31 84 16 3 10 45 .352 102 51 2 2 5 1 .309
この手のデータは、解析前に散布図を描いて全体像を見ておくのが重要らしい。
#数値データだけにしておく data1 <- data0[,-c(1:3)] plot(data1, cex=0.1)
うん、なるほどわからん。
相関行列を求める。
cor(data1)
打率 試合数 打席 打数 得点 安打 二塁打 三塁打 本塁打 打点 長打率 三振 四球 死球 犠打 犠飛 盗塁 出塁率 打率 1 0.38 0.49 0.51 0.69 0.88 0.36 0.02 0.43 0.5 0.74 -0.29 0.18 0.2 -0.1 0.13 0.26 0.79 試合数 0.38 1 0.79 0.74 0.45 0.63 0.32 0.21 0.01 0.05 0.14 0.21 0.32 0.48 0.19 0.09 0.45 0.42 打席 0.49 0.79 1 0.93 0.77 0.8 0.43 0.3 0.04 0.08 0.22 0.23 0.44 0.3 0.29 0.14 0.67 0.51 打数 0.51 0.74 0.93 1 0.78 0.85 0.51 0.27 0.03 0.04 0.23 0.24 0.16 0.27 0.18 -0.04 0.71 0.33 得点 0.69 0.45 0.77 0.78 1 0.85 0.52 0.33 0.37 0.31 0.58 0.28 0.3 0.29 -0.02 0.15 0.64 0.6 安打 0.88 0.63 0.8 0.85 0.85 1 0.5 0.16 0.28 0.31 0.57 -0.03 0.21 0.26 0.03 0.04 0.56 0.67 二塁打 0.36 0.32 0.43 0.51 0.52 0.5 1 -0.18 0.54 0.59 0.61 0.34 0.17 0.09 -0.37 0.4 0.07 0.29 三塁打 0.02 0.21 0.3 0.27 0.33 0.16 -0.18 1 -0.3 -0.31 -0.13 0.38 0.14 0.03 0.14 0.06 0.64 0.05 本塁打 0.43 0.01 0.04 0.03 0.37 0.28 0.54 -0.3 1 0.89 0.91 0.12 0.23 0.2 -0.54 0.5 -0.25 0.47 打点 0.5 0.05 0.08 0.04 0.31 0.31 0.59 -0.31 0.89 1 0.87 -0.1 0.33 0.01 -0.5 0.7 -0.37 0.54 長打率 0.74 0.14 0.22 0.23 0.58 0.57 0.61 -0.13 0.91 0.87 1 0.02 0.26 0.21 -0.48 0.48 -0.05 0.68 三振 -0.29 0.21 0.23 0.24 0.28 -0.03 0.34 0.38 0.12 -0.1 0.02 1 0.14 0.32 -0.19 0.02 0.29 -0.11 四球 0.18 0.32 0.44 0.16 0.3 0.21 0.17 0.14 0.23 0.33 0.26 0.14 1 -0.08 -0.17 0.49 0.09 0.72 死球 0.2 0.48 0.3 0.27 0.29 0.26 0.09 0.03 0.2 0.01 0.21 0.32 -0.08 1 0.11 0.05 0.12 0.21 犠打 -0.1 0.19 0.29 0.18 -0.02 0.03 -0.37 0.14 -0.54 -0.5 -0.48 -0.19 -0.17 0.11 1 -0.19 0.29 -0.18 犠飛 0.13 0.09 0.14 -0.04 0.15 0.04 0.4 0.06 0.5 0.7 0.48 0.02 0.49 0.05 -0.19 1 -0.26 0.39 盗塁 0.26 0.45 0.67 0.71 0.64 0.56 0.07 0.64 -0.25 -0.37 -0.05 0.29 0.09 0.12 0.29 -0.26 1 0.16 出塁率 0.79 0.42 0.51 0.33 0.6 0.67 0.29 0.05 0.47 0.54 0.68 -0.11 0.72 0.21 -0.18 0.39 0.16 1
library(gplots) colors <- greenred(20) image(seq(nrow(cors)), seq(ncol(cors)), cors, xlab="", ylab="", axes=FALSE, col=colors, zlim=c(-1, 1)) axis(1, at=seq(nrow(cors)), label=rownames(cors), las=2) axis(2, at=seq(ncol(cors)), label=rownames(cors), las=2)
対角線上は同じパラメータ同士なので、相関係数は1になる。
本塁打や長打率は強い相関があり、逆にこれらは犠打（バント）と強い逆相関がある。
隣の犠飛（フライ）とはそこそこの正の相関がある。みたいな。
主成分分析を行う。
20121226追記
標準化したほうがいい（しないという観点もあるが）というご指摘を受けました。
なぜ標準化するかという話はリンクで。
#respca <- prcomp(data0[, -c(1:3)]) respca <- prcomp(data0[, -c(1:3)], scale=TRUE) respca$rotation cols <- c("black", topo.colors(ncol(data0[, -c(1:3)]) - 2), "red") barplot(t(respca$rotation), beside=TRUE, las=2, col=cols, ylim=c(-1, 1)) summary(prcomp(data0[, -c(1:3)]))
主成分それぞれが、各パラメータにどのくらい影響するかをプロットしているっぽい。こんなん小さすぎて見にくい。
Importance of components: PC1 PC2 PC3 PC4 PC5 PC6 Standard deviation 77.202 24.63226 22.63847 20.1725 11.15772 9.45720 Proportion of Variance 0.763 0.07768 0.06561 0.0521 0.01594 0.01145 Cumulative Proportion 0.763 0.84070 0.90632 0.9584 0.97435 0.98580
Cumulative Proportionとは、各主成分ひとつがどれほどの説明能力を有していて、それを合わせていくと総合でどれほどの説明能力を持つか、的な指標だから、PC2まで見ると84%説明できる、となるっぽい。
PC3まで持ちだせば90%までいくが、私たちは二次元表が一番理解できる（それ以上は賢くないと無理）ので、PC1とPC2でどれほど説明するかを上の棒グラフから抜き出すと
barplot(t(respca$rotation[, 1:2]), beside=TRUE, las=2, col=1:2, ylim=c(-1, 1))
上のリンクで
主成分得点係数に、選手一人一人の要素値をかけて合計すると各主成分の得点がでます。
とあるのだが、計算法がものすごい勢いで省略されているので、例のごとくパクると
pca_score <- scale(data1) %*% eigen(cor(data1))$vectors *sqrt(nrow(data1)/(nrow(data1) - 1)) plot(pca_score[, 1:2], xlab="PC1", ylab="PC2", xlim=c(-1, 1)*6, ylim=c(-1, 1)*6) text(pca_score[,1:2]+0.1, rownames(pca_score))
この散布図と、主成分棒グラフから考えると、
第一主成分は、1試合あたりの出塁可能性だろうか…PC1が低いほど、打率や出塁率が高い気がする。
棒グラフでは、これらのパラメータの相関はほぼ0になっている。「相関の無い主成分とよばれる値に変換する」という操作がここに出ているのだろうか…まあよくわからん。
第二主成分は、1打席あたりの得点可能性だろうか…PC2が高いほど、打点やホームラン数が多い気がする。
棒グラフでは、むしろこれらのパラメータは相関が高いので、どうなんだろう。別の解釈があるんだろう。
各球団がどんなタイプの選手を揃えているかプロットすると
plot(pca_score[, 1:2], type="n", xlab="PC1", ylab="PC2", xlim=c(-1, 1)*6, ylim=c(-1, 1)*6) text(pca_score[,1:2]+0.1, as.character(data0[, 3]))
巨人は得点可能性が高い選手を揃えているような感じか。
