本稿はRを学び始めたプログラマが学習中に残したメモ書きです。
2回目の今回は、Rさんに「野球のチーム打率と得点はどの程度の相関があるの？」という質問をしてみようとした様子が記録されています。
データは過去6年分を使用。12チームだからわずか72行。統計データというには無理があるけど学習用としては良いサイズか。
Rのバージョンは2.10.1。
今回のデータはプロ野球ヌルデータ置き場様を参照しました。
上記サイトには2006年から2011年までの6年分のデータが置いてあります。打率や出塁率だけでなく、打数や二塁打、三塁打の数からOPS、RC、XR等のセイバー系の数値まで幅広く載ってます。
とりあえずそれらの中からベースになるものをコピってこんなデータを作ります。
年 チーム 打率 試合数 打席 打数 得点 安打 内野安打 二塁打 三塁打 本塁打 塁打数 打点 三振 四球 故意四球 死球 犠打 犠飛 盗塁 盗塁死 失策 捕逸 併殺 2011 中日 .228 144 5235 4583 419 1044 90 171 25 82 1511 401 988 423 25 42 164 23 41 20 83 4 99 2011 ヤクルト .244 144 5321 4645 484 1132 136 169 19 85 1594 461 877 430 27 46 171 29 43 15 56 4 96 2011 巨人 .243 144 5242 4716 471 1145 102 173 14 108 1670 455 1003 323 33 55 124 24 106 40 67 4 79 ・ ・ ・
データの抽出を試してみる。例として2008年の西武のデータを取り出す。
# CSV読み込み
team_stats = read.csv('team_stats.txt', sep="\t" )
# 抽出してみる
subset( team_stats, チーム == "西武" & 年 == 2008 )["打率"]
結果
打率 43 0.27
今回のデータには出塁率（On-base percentage）は入れてないので、計算して列を追加してみる。
出塁率の計算式は以下。
(安打+四球+死球）÷（打数+四球+死球+犠飛）
もっとうまい書き方がある気がするけど、よくわからないのでとりあえず愚直に書いてみる。
team_stats["出塁率"] <- (team_stats["安打"] + team_stats["四球"] + team_stats["死球"]) / (team_stats["打数"] + team_stats["四球"] + team_stats["死球"] + team_stats["犠飛"])
これで出塁率が追加された。
rowSumsで行の合算をして算出しても書けるか。
team_stats["出塁率"] <-
rowSums( team_stats[c("安打", "四球", "死球")] ) /
rowSums( team_stats[c("打数", "四球","死球", "犠飛")])
ついでに打率が厘までしかないので、もう少しちゃんと出しておく。
team_stats["打率"] = team_stats["安打"] / team_stats["打数"]
せっかく出塁率を出したので、このデータをファイルに保存しておくことにする。
write.table(team_stats, "foo.txt")
上記の記述だと、ダブルコーテーション付き、スペース区切り、行番号付きで出力される。
tsvの方が好きなので、タブ区切り、コーテーションなし、行番号なしにしてみる。
write.table(team_stats, "foo.txt", quote = FALSE, sep = "\t", row.names = FALSE)
読み込むときは普通にread.csvなりread.tableなり。
team_stats = read.csv('foo.txt', sep="\t" )
年間チーム打率やチーム出塁率のベスト10を見てみたい気がした。
# 打率降順でソート sorted = order(team_stats["打率"], decreasing = TRUE) sorted = team_stats[ sorted, ] # トップ10を出力 head( sorted, n=10 )[1:3]
打率はこんな結果になった。
年 チーム 打率 14 2010 阪神 0.2895155 31 2009 日本ハム 0.2784553 49 2007 巨人 0.2758970 25 2009 巨人 0.2754959 21 2010 ロッテ 0.2746135 68 2006 西武 0.2745056 36 2009 オリックス 0.2742625 22 2010 日本ハム 0.2738880 47 2008 楽天 0.2723361 40 2008 広島 0.2712072
出塁率はこんな結果。
年 チーム 出塁率 21 2010 ロッテ 0.3518319 14 2010 阪神 0.3449900 31 2009 日本ハム 0.3434121 20 2010 西武 0.3430350 68 2006 西武 0.3422884 16 2010 ヤクルト 0.3403786 47 2008 楽天 0.3397861 50 2007 中日 0.3380961 32 2009 楽天 0.3357421 23 2010 オリックス 0.3352866
ベスト10として見ると必ずしも両者は一致しない。
打率と出塁率との間にはどの程度の相関が見られるのだろうか。前回も使った最小二乗法でさらっと見てみる。
plot( team_stats[ c("打率", "出塁率") ] )
x <- lsfit( team_stats[,"打率"], team_stats[,"出塁率"] )
abline(x, col="red")
直線の係数を見てみると、こんな感じ。
> coefficients(x) Intercept X 0.05625189 1.01863490
「出塁率 = 打率 * 1.0186 + 0.0562」。大雑把に言えば「打率に5分6厘足せば出塁率」と言えそう。
もう少し詳しく見てみる。
summary( lm( team_stats[,"打率"] ~ team_stats[,"出塁率"] ) )
結果、Multiple R-Squared（決定係数）は0.735と出た。打率と得点の場合は0.7弱だった記憶があるのでそれよりは高い程度。
統一球（2011年から導入）の影響を目で見てみたかったので、年度ごとの打率と出塁率を見てみる。
# 打率を赤で書いてみる
plot( team_stats[ c( "年", "打率" ) ], col="2", ylim=c(0.20, 0.37) )
# 出塁率を青で重ねて表示する
par(new=T)
plot( team_stats[ c( "年", "出塁率" ) ], col="4", ylim=c(0.20, 0.37) )
# 打率の年ごとの平均を重ねて表示する
par(new=T)
plot( aggregate( team_stats["打率"], team_stats["年"], mean ), col="2", type="l", ylim=c(0.20, 0.37) )
# 出塁率の年ごとの平均を重ねて表示する
par(new=T)
plot( aggregate( team_stats["出塁率"], team_stats["年"], mean ), col="4", type="l", ylim=c(0.20, 0.37) )X軸が年。赤が打率、青が出塁率。線は平均値。
2010年が非常に高い数値だっただけに、2011年の落ち込みが目立つ。
よく言われている、得点との相関について。
# グラフを2つ描く par( mfrow = c(2, 2) ) # 出塁率と得点 plot( team_stats[ c( "出塁率", "得点" ) ] ) x <- lsfit( team_stats[,"出塁率"], team_stats[,"得点"] ) abline(x) # 打率と得点 plot( team_stats[ c( "打率", "得点" ) ] ) x <- lsfit( team_stats[,"打率"], team_stats[,"得点"] ) abline(x)
打率と得点の決定係数は、0.6782。出塁率と得点の決定係数は、0.726と出た。出塁率の相関もそれほど高いわけじゃないのね。
一応、OPSも見てみる。
# 長打率（塁打/打数）の追加 team_stats["長打率"] <- team_stats["塁打数"] / team_stats["打数"] # OPS（出塁率+長打率）の追加 team_stats["OPS"] <- team_stats["出塁率"] + team_stats["長打率"] # グラフを2つ描く par( mfrow = c(2, 2) ) # 長打率と得点 plot( team_stats[ c( "長打率", "得点" ) ] ) x <- lsfit( team_stats[,"長打率"], team_stats[,"得点"] ) abline(x, col="red") # OPSと得点 plot( team_stats[ c( "OPS", "得点" ) ] ) x <- lsfit( team_stats[,"OPS"], team_stats[,"得点"] ) abline(x, col="red")
決定係数をまとめると、以下のようになった。
| 打率 | 0.6782 |
| 出塁率 | 0.7260 |
| 長打率 | 0.8227 |
| OPS | 0.8935 |
軽く調べてみた限りではこれらの値は、多少のズレはあるものの既に公開されている情報と同様の傾向を示すものになっている。
XRやRC、BsRあたりでも決定係数は0.925程度になるそうな。OPSが簡易な割に有用とされる理由がよく分かる。
四死球、単打、二塁打、三塁打、本塁打の関係を、出塁率は1:1:1:1:1、長打率は0:1:2:3:4として算出する。これを足すと1:2:3:4:5という対比になる。重回帰を使ったXRだとだいたい0.34:0.50:0.72:1.04:144で計算してるので、OPSは割といい線いった対比になっている。