セイバーメトリクス

Rによるセイバーメトリクス　をじっくり学ぶ　　得点と勝利の関係について②　日本プロ野球編！ドラゴンズはどうか！？

今回は、得点と勝利の関係について　

プロ野球のデータを使って、解析してみます！

　

参考は例によって偉大なる著書

Rによるセイバーメトリクス入門です。

　

得点と勝利の関係について

すべてのスポーツの目標は、試合に勝つことです。

　

野球において勝利とは、相手より多くの点を取ることに尽きます。

　

その中で、自チームが取った得点　と　自チームが取られた得点

は大きく勝敗に影響を与えると言われています。

　

そのあたりの解析を前回、前々回と行いました。

　

プロ野球データFreakからの抽出

プロ野球のデータを使用する上で、

使用するデータは

プロ野球データFreakから抽出しました。

https://baseball-data.com/team/standings.html

https://baseball-data.com/team/standings.html

このようなデータがありますので

コピーして貼り付けを繰り返します。

　

2009年から2022年（2020年短縮シーズンは除く）のデータを　

CSV形式にして保存しました。

　

このデータをRに取り込みます。

my_teams_npb <- read_csv("data/npb.csv")

そうすると格納されました。

head(my_teams_npb)

  yearID teamID     G     W     L     D  Wpct     R R_ave    RA RA_ave    RD   Ave

   <dbl> <chr>  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl> <dbl> <dbl>

1   2022 YS       143    80    59     4 0.576   619  4.33   566   3.96    53 0.25 

2   2022 DB       143    73    68     2 0.518   497  3.48   534   3.73   -37 0.251

3   2022 HT       143    68    71     4 0.489   489  3.42   428   2.99    61 0.243

4   2022 YG       143    68    72     3 0.486   548  3.83   589   4.12   -41 0.242

5   2022 C        143    66    74     3 0.471   552  3.86   544   3.8      8 0.257

6   2022 CD       143    66    75     2 0.468   414  2.9    495   3.46   -81 0.247

run_diff_npb <- ggplot(my_teams, aes(x = RD, y = Wpct))+
　geom_point()+
　scale_x_continuous("Run differential")+
　scale_y_continuous("Winning percentage")

run_diff_npb

そうすると、こんなグラフができます

プロ野球　得失点差と勝率の散布図

　

やはり、得失点差と勝率が相関関係にあるグラフになりました！

　

恐るべし・・・得失点差は勝率に大きく関係してきます。

線形回帰

ではこのグラフについてモデル化します。

linfit_npb<- lm(Wpct ~ RD, data = my_teams_npb)
linfit_npb

Call:

lm(formula = Wpct ~ RD, data = my_teams_npb)

Coefficients:

(Intercept)           RD  

  0.5000833    0.0007504  

　

ということで、以下のようなモデルが成り立つことがわかりました。

勝率　＝　0.5000833　+　0.0007504×得失点差

　

グラフ化するとこうなります！

プロ野球　得失点差と勝率の散布図

　

美しいグラフですね。

　

モデルからの外れデータの解析

それでは、過去このモデルから外れたチームについて解析します。

まずは、残差について計算します。

my_team_aug_npb <- augment(linfit_npb, data=my_teams_npb)

このグラフを作成します。

base_plot_npb<- ggplot(my_team_aug_npb, aes(x = RD, y = .resid))+
　geom_point(alpha = 0.3)+
　geom_hline(yintercept = 0, linetype =3)+
　xlab("Run differential")+ylab("Residual")

グラフはあとのお楽しみです。。。

　

モデルとの差分が大きい順に6チーム抽出します。

highlight_npb <- my_team_aug%>%
 arrange(desc(abs(.resid)))%>%
 head(6)

　

これをグラフにラベル付けして完成です。

base_plot_npb+
　geom_point(data = highlight_npb, color=crcblue)+
　geom_text_repel(data = highlight_npb, color = crcblue,
　　aes(label = paste(teamID, yearID)))

そうするとこのような結果になりました！！

プロ野球　得失点差とモデルとの差分のデータ

　

このグラフは非常に面白いですよ！

　

そうすると、まず目立つのが　

2012年のドラゴンズ

2012年の順位表

この年のドラゴンズは、2010年、2011年と連覇のあと

高木守道監督に交代となった年です。

　

得点が＋18点となっていて、

モデル上では勝率0.514、勝利65勝と予測されました。

なんと、10勝近く上乗せしてしました。

　

ただ、巨人が強かったのかも・・・

　

もう一つ目立つのが、

2013年のソフトバンクホークス

2013年の順位表

得点が98点も上回っているのに、勝ち越しはおよそ4勝

なんなら楽天よりもいい成績ですが・・・

結果は4位となっています。

　

誤差について

データについてはある程度ばらつきがあります。

では、どこまでが誤差の範囲内なのでしょうか？

　

ここでは、平均二乗誤差を求めます。

（モデルとの差分を2乗して、平方根をとります）

resid_summary_npb <- my_team_aug_npb%>%
　summarize(N =n(),avg = mean(.resid),
　　　　　　　　　　　　　　　　　　　　RMSE = sqrt(mean(.resid^2)))

　

# A tibble: 1 × 3

      N       avg   RMSE

  <int>     <dbl>  <dbl>

1   156 -9.47e-17 0.0275

　

そうすると、　RMSEが0.0275となりました。

　

±0.0275の間にデータの3分の2が含まれ

2×±0.0275の間に95％のデータが含まれます。

　

つまり、

144試合のうち±4勝ぐらいは誤差の範囲内ということになります。

　

なにはともあれ、

得点と失点の得失点差で大方勝率は予測できます。

　

2023年順位表

ドラゴンズは　2023年6月24日現在

失点はリーグ2位の211点ですが、、、

得点はワーストの177点

そして得失点差が-34

　

やはり得点を増やしていくしかないですね。

-セイバーメトリクス