野球のデータを分析してみたいと思いながらはや数年、プロ野球データフリークのサイトからコツコツとダウンロードしてきたデータをちょっとずついじりながら楽しんでいこうと思っています。
今回参考になったのはこの本です。
今回はプロ野球データフリークのサイトにある2009年から2023年までのNPB12球団のチームデータをダウンロードしたデータを使い分析します。
過去データを頑張ってまとめたエクセルファイルをgithubにアップロードしてありますので、こちらからダウンロードして使ってみてください。
library(openxlsx)
datT<-read.xlsx("C:/Users/ユーザー名/Downloads/team_data.xlsx",sheet="Sheet1")
colnames(datT)
データの項目はこんな感じです。
> colnames(datT)
[1] "年度" "順位" "リーグ" "チーム" "試合" "勝利" "敗北" "引分" "打率" "得点"
[11] "打数" "安打" "二塁打" "三塁打" "本塁打" "盗塁" "犠打" "四球" "死球" "三振"
[21] "併殺打" "出塁率" "長打率" "OPS" "NOI" "IsoD" "IsoP" "得点平均" "安打平均" "投球回"
[31] "防御率" "セーブ" "ホールド" "完投" "完封勝" "被安打" "被本塁打" "与四球" "与死球" "奪三振"
[41] "失点" "自責点" "WHIP" "DIPS" "失点平均" "被安平均"
実際にプロ野球のデータを使って各指標を見ていきます。
ちょっと指標が少ないので追加します。
library(tidyverse)
datT2<-datT %>%
mutate(単打=安打-二塁打-三塁打-本塁打) %>%
mutate(犠飛=round((安打+四球+死球)/出塁率)-(打数+四球+死球)) %>%
mutate(wOBA=(0.9*単打+1.3*二塁打+1.6*三塁打+2.0*本塁打+0.7*(四球+死球))/(打数+四球+死球+犠飛)) %>%
mutate(ピタゴラス勝率=得点^2/(得点^2+失点^2))%>%
まずはピタゴラス勝率です。
ピタゴラス勝率とは、野球版ピタゴラスの定理ともいわれているもので、
ピタゴラス勝率=得点^{2}÷(得点^{2}+失点^{2})
で定義されてます。得点と失点のデータで勝率を予測できてしまうというものです。
なんとなくピタゴラスの定理の数式に似てますね。
実際にピタゴラス勝率と勝率の関係を見てみます。
#グラフに回帰式や決定係数等を入れるためのパッケージ
install.packages("ggpmisc")
library(ggpmisc)
#ピタゴラス勝率と勝率
ggplot(data=datT2,mapping=aes(x=ピタゴラス勝率,y=勝利/(試合-引分)))+
geom_point(size=2,shape=21)+labs(x="ピタゴラス勝率",y="勝率")+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
sep = "*\", \"*")),
label.x = "right",
label.y = "bottom",
parse = TRUE)+
theme_bw()
大体8割くらいは説明できているという結果になりました。
次は各打撃指標と得点との相関を見ていきます。
まずは打率との関係です。
打率=安打/打数
ggplot(data=datT2,mapping=aes(x=打率,y=得点平均))+
geom_point(size=2,shape=21)+labs(x="打率",y="平均得点")+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
sep = "*\", \"*")),
label.x = "right",
label.y = "bottom",
parse = TRUE)+
theme_bw()
出塁率との関係です。
出塁率=(安打+四球+死球)/(打数+四球+死球+犠飛)
ggplot(data=datT2,mapping=aes(x=出塁率,y=得点平均))+
geom_point(size=2,shape=21)+labs(x="出塁率",y="平均得点")+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
sep = "*\", \"*")),
label.x = "right",
label.y = "bottom",
parse = TRUE)+
theme_bw()
長打率との関係です。
長打率=塁打/打数
塁打とは単打を1、二塁打を2、三塁打を3、本塁打を4として数えた安打数です。
ggplot(data=datT2,mapping=aes(x=長打率,y=得点平均))+
geom_point(size=2,shape=21)+labs(x="長打率",y="平均得点")+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
sep = "*\", \"*")),
label.x = "right",
label.y = "bottom",
parse = TRUE)+
theme_bw()
OPS（On-base plus slugging）との関係です。
OPS=出塁率+長打率
ggplot(data=datT2,mapping=aes(x=OPS,y=得点平均))+
geom_point(size=2,shape=21)+labs(x="OPS",y="平均得点")+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
sep = "*\", \"*")),
label.x = "right",
label.y = "bottom",
parse = TRUE)+
theme_bw()
最後に加重出塁率（wOBA:Weighted On-Base Average）との関係も見てみます。
wOBA=(0.9*単打+1.3*二塁打+1.6*三塁打+2.0*本塁打+0.7*(四球+死球))/(打数+四球+死球+犠飛)
加重出塁率は各出塁に得点価値に基づいた加重を加えた指標で、
「打者が打撃あたりでどれだけチームの得点増に貢献する打撃をしているか」
を表します。
ggplot(data=datT2,mapping=aes(x=wOBA,y=得点平均))+
geom_point(size=2,shape=21)+labs(x="wOBA",y="平均得点")+
geom_smooth(method = "lm", formula = y ~ x)+
stat_poly_eq(formula = y ~ x,aes(label = paste(stat(eq.label),
stat(rr.label),
sep = "*\", \"*")),
label.x = "right",
label.y = "bottom",
parse = TRUE)+
theme_bw()
こうしてみると打率だけでは十分に打撃評価ができないのがわかりますね。
また、加重出塁率の方がOPSよりもより詳細な分析指標にはなっているはずですが、得点との相関でみると同じくらいの精度になっているので、いかにOPSがシンプルかつ有効な指標であるかがわかります。
昨年度の各球団のwOBAを見てみます。
library(dplyr)
wOBA2023 <- datT2 %>%
filter(年度=="2023") %>%
select(チーム,wOBA)%>%
arrange(-wOBA)
> wOBA2023
チーム wOBA
1 巨人 0.3135741
2 楽天 0.3062023
3 ソフトバンク 0.3054725
4 オリックス 0.3046036
5 阪神 0.3042225
6 ヤクルト 0.3034910
7 横浜 0.3008999
8 ロッテ 0.2994156
9 広島 0.2964967
10 日本ハム 0.2886672
11 西武 0.2863681
12 中日 0.2752864
選手（球団）の力もあるとは思いますが、なんとなく巨人やソフトバンクなど本拠地がホームランが入りやすい球団で高く、日ハムや中日など本拠地が広い球場の球団は低い傾向があるように見えますね。
球場補正したらどうなるかやってみたいです。