RPubsでの公開のテスト.

なんとなくNPBのピタゴラス勝率でもグラフにする

ピタゴラス勝率 vs 実際の勝率

’18 6/3 14時時点でNPB公式のチームごとの打者と投手成績からスクレイピング.

ピタゴラス勝率がわからん方は, Baseball Concreteさんの得点を勝利に換算するを参照.

データ準備

# 必要なpackage: tidyverse

# data frame2つ
# team_pにチーム投手成績, team_bにチーム打者成績が入っている状態を想定している
# 列名は別の目的のために既に変更されているのでコメントを確認されたい

# チーム投手データから勝率と失点を得る
data <- team_p %>% 
  select(T, W, L, R)%>% # チーム名, 勝利, 負け, 失点が必要
  mutate(Wpct = as.numeric(W)/(as.numeric(W) + as.numeric(L)))%>%  # 勝率
  rename(RA = R) # 失点がRになっているけど, これがあとで不都合なのでRAにrename
   
# チーム打者データから得点を得て,ピタゴラス勝率を計算
data <- data %>% 
  left_join(team_b %>% 
              select(T, R))%>% # こっちのRは得点 
      mutate(PytWpct = R ^ 1.7 / (R ^ 1.7 + RA ^ 1.7))  # PytWpct = ピタゴラス勝率
## Joining, by = "T"

指数 (Pythagorean exponent) は05-17から計算して1.7を採用した. 計算はMarchi and Albert (pp.95) を参照 (計算はここでは示していない). ちなみにMarchi and AlbertではMLB 01-11ではだいたい1.9が当てはまりがいいことが示されている.

描画

ggplot(data, aes(x = Wpct, 
                     y = PytWpct,
                     label = T)) + 
      geom_point() + 
      geom_text(hjust = 0, nudge_x = 0.01)+
      theme_bw(base_family = "HiraKakuPro-W3") +
      coord_equal()+
      theme(axis.text.x = element_text(size=10),
            axis.text.y = element_text(size=10),
            axis.title = element_text(size = 12),
            title = element_text(size = 14)) +
      geom_abline(intercept = 0, 
                  slope = 1,
                  colour = "red",         
                  size = 2,               
                  linetype = 2,           
                  alpha = 0.5) +
      labs(title = "勝率 vs ピタゴラス勝率.",
           subtitle = "指数 = 1.7; 赤の破線は y = x.",
           x = "勝率", 
           y = "ピタゴラス勝率",
           caption = "Source: NPB公式")

感想は特に無いです. ピタゴラス勝率からの乖離を監督の能力みたいなものとして議論するのだけは止めてください (そういうことがしたいのであれば, 監督を説明変数として組み込んだ上で交絡を調整して効果を推定するモデルを作ってください).

ある失点状況における1勝あたりに必要な得点

失点を固定し, 得点を振って, 指数1.7におけるピタゴラス勝率を計算する. これで144試合での勝利数を計算できるので, 得点数がどれぐらい増えた時にこのピタゴラス勝率のモデル (指数1.7) で1勝増えるかがわかる.

データ準備 & 計算

RD_data <- data.frame(R = seq(400, 700, 10),
                      RA = 550) %>% # 3.81944失点/G 比較的切りのいいそれらしい数字 深い意味はない
  mutate(PytWpct = R ^ 1.7 / (R ^ 1.7 + RA ^ 1.7),
         Wins = 144 * PytWpct) # 推定勝利数 
round(RD_data, 2)
##      R  RA PytWpct  Wins
## 1  400 550    0.37 52.97
## 2  410 550    0.38 54.39
## 3  420 550    0.39 55.78
## 4  430 550    0.40 57.15
## 5  440 550    0.41 58.51
## 6  450 550    0.42 59.84
## 7  460 550    0.42 61.15
## 8  470 550    0.43 62.44
## 9  480 550    0.44 63.71
## 10 490 550    0.45 64.95
## 11 500 550    0.46 66.18
## 12 510 550    0.47 67.39
## 13 520 550    0.48 68.57
## 14 530 550    0.48 69.73
## 15 540 550    0.49 70.88
## 16 550 550    0.50 72.00
## 17 560 550    0.51 73.10
## 18 570 550    0.52 74.19
## 19 580 550    0.52 75.25
## 20 590 550    0.53 76.29
## 21 600 550    0.54 77.32
## 22 610 550    0.54 78.32
## 23 620 550    0.55 79.31
## 24 630 550    0.56 80.27
## 25 640 550    0.56 81.22
## 26 650 550    0.57 82.16
## 27 660 550    0.58 83.07
## 28 670 550    0.58 83.97
## 29 680 550    0.59 84.85
## 30 690 550    0.60 85.71
## 31 700 550    0.60 86.56

失点は550で固定している. 当然失点と同じ得点 (550) の時に勝率5割 (72勝) .

round(RD_data[c(16, 21),], 2)
##      R  RA PytWpct  Wins
## 16 550 550    0.50 72.00
## 21 600 550    0.54 77.32

ここで, 50得点増やすと77.32勝なので, 得点/勝利は50 / 5.32でだいたい9.4. よくいわれる10と近い数値となった.
しかし, 400得点と700得点までの推定勝利の変化を見ると, その差分は一定ではなさそう. data frame RD_dataの推定勝利数の列の前方差分をとっていく.

round(diff(RD_data$Wins), 2)
##  [1] 1.41 1.39 1.37 1.35 1.33 1.31 1.29 1.27 1.25 1.23 1.21 1.18 1.16 1.14
## [15] 1.12 1.10 1.08 1.06 1.04 1.02 1.00 0.99 0.97 0.95 0.93 0.91 0.90 0.88
## [29] 0.86 0.85

得点が400から410への増加では1.4勝増えているが, 690から700への増加では0.85勝しか増えていない.

変化を図でも確認.

得失点 vs 勝利数の描画

ggplot(RD_data, aes(x = R - 550, 
                    y = Wins)) + 
  　　geom_smooth()+
      geom_point() + 
      theme_bw(base_family = "HiraKakuPro-W3") +
      theme(axis.text.x = element_text(size=10),
            axis.text.y = element_text(size=10),
            axis.title = element_text(size = 12),
            title = element_text(size = 14)) +
      labs(title = "得失点 vs 勝利数.",
           subtitle = "失点は550/144試合で固定.",
           x = "得失点", 
           y = "推定勝利数 (144試合あたり)")
## `geom_smooth()` using method = 'loess'

平滑曲線を見ると傾いていることがわかる. 仮に線形回帰を使って勝率を得失点で説明させた場合, 定義上この関係は直線になっているはずである. ピタゴラス勝率のモデルでは, 少なくともここで扱った得失点範囲において, 得点が増えるにつれて1勝あたりに必要な得点が増加していくと“考えている”ことがわかる. モデルに利益の逓減が組み込まれていることは直感的には合理的だと思われるが, 効率の低下量が適切かどうかはもうちょっと確認してみたくなる感じはしないでもない (一応補足しておくと, ある程度以上長いシーズン成績で計算する場合, 得失点で説明させる線形回帰モデルはそれはそれで非常によく当てはまる).

得点/勝利について, もっとちゃんとやるならMarchi and Albert (pp.100-102) を参照.

参考

データはNPB公式.

Marchi and Albert, The Relation between Rus and Wins, in Analyzing Baseball Data with R, CRC press, 2013.

Baseball Concrete, 得点を勝利に換算する.

さらに詳しく

Ben Dilday, Graphical MLB Standings, 2018.
この可視化では, 予想勝利数を示す線分の間の距離に注目することで, 勝利数の変化による得点/勝利の違いに加えて, 得点や失点の絶対値の大小による得点/勝利の変化も確認できる.