今回は年齢と成績の関係について見ていきます。

初回でも紹介したセイバーメトリクス入門には野手は26～27歳、投手は21歳が成績のピークとありました。
ただ成績のピークを出す計算方法が正直よくわからないので、手持ちのデータでいくつか簡単に出せたものを紹介します。

ますは野手から。
野手の個人成績のデータを読み込みます。

library(openxlsx)
datH<-read.xlsx("C:/Users/ユーザー名/Downloads/hitter_data.xlsx",sheet="Sheet1")
head(datH)

> head(datH)
                              選手名 生年月日     投打 投 打   守備   出身地 身長 血液型 体重
1           栗原健太(くりはらけんた)    29959 右投右打 右 右 内野手     山形  183      O   95
2         東出輝裕(ひがしであきひろ)    29454 右投左打 右 左 内野手     福井  171      A   73
3               嶋重宣(しましげのぶ)    27927 左投左打 左 左 外野手     埼玉  181      A   95
4         石原慶幸(いしはらよしゆき)    29105 右投右打 右 右   捕手     岐阜  177      A   82
5           緒方孝市(おがたこういち)    25197 右投右打 右 右 外野手     佐賀  181      A   80
6 フィリップス(あんでぃふぃりっぷす)    28221 右投右打 右 右 内野手 アメリカ  183   不明   93
   年俸 年度   リーグ     球団 試合数 打席数 打数 得点 安打 二塁打 三塁打 本塁打 塁打 打点 盗塁
1 13000 2009 セリーグ 広島東洋    140    582  521   68  134     21      0     23  224   79    1
2 10000 2009 セリーグ 広島東洋    142    625  558   71  164     16      8      0  196   26   14
3  5500 2009 セリーグ 広島東洋     89    198  175   12   40      9      0      2   55   17    3
4  5000 2009 セリーグ 広島東洋    124    422  364   31   75     15      1     10  122   37    2
5  4500 2009 セリーグ 広島東洋     53     60   49    2    9      1      1      0   12    7    2
6  4000 2009 セリーグ 広島東洋     74    301  264   35   70     15      1     15  132   50    0
  盗塁刺 犠打 犠飛 四球 死球 三振 併殺打  打率 出塁率 長打率   OPS
1      6    0    2   48    7   82     11 0.257  0.327  0.430 0.757
2      7   19    3   44    1   39      5 0.294  0.345  0.351 0.696
3      1    0    5   15    3   34      7 0.229  0.293  0.314 0.607
4      3   11    4   39    4   90     11 0.206  0.287  0.335 0.622
5      0    0    1    9    1    2      0 0.184  0.317  0.245 0.562
6      0    0    5   27    5   48      7 0.265  0.339  0.500 0.839

生年月日が数値になっているのでデータを扱いやすい形に整形します。

library(tidyverse)
datH<-datH %>% 
  mutate(生年月日=as.Date(生年月日, origin = "1899-12-30"))  %>% 
  mutate(生年=year(生年月日)) %>% 
  mutate(生月=month(生年月日))

スタッツを追加します。

datH2<-datH %>% 
  mutate(年齢=年度-生年)%>%
  mutate(単打=安打-二塁打-三塁打-本塁打) %>% 
  mutate(wOBA=(0.9*単打+1.3*二塁打+1.6*三塁打+2.0*本塁打+0.7*(四球+死球))/(打数+四球+死球+犠飛)) %>%

年齢のデータですが、シーズン終了に近い10月～12月生まれの選手を－1歳で補正します。

datH2<-datH2 %>% 
  mutate(年齢2=if_else(生月>=10, true = 年齢-1,false = 年齢))

まずはシンプルにwOBAを見てみます。

年齢とwOBA

ggplot(data=datH2,aes(x=年齢2,y=wOBA))+
  geom_point()+labs(x="年齢",y="wOBA")+
  scale_x_continuous(breaks = seq(min(datH2$年齢2),max(datH2$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

見にくいので0.5までで拡大表示します。

年齢とwOBA（0.5までの拡大）

ggplot(data=datH2,aes(x=年齢2,y=wOBA))+
  geom_point()+labs(x="年齢",y="wOBA")+
  scale_x_continuous(breaks = seq(min(datH2$年齢2),max(datH2$年齢2),by = 1),minor_breaks = NULL)+
  coord_cartesian(ylim = c(0, 0.5))+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

成績のピークが35歳くらいになっていて実態とはかけ離れた結果になってます。
長く活躍できている選手のデータに引っ張られている感じですね。

ここで補正方法を考えます。
まず、ボールや何らかの原因で年度毎に全体的に成績の上下があるので、年ごとの平均の成績との差を出していきます。

年度ごとのwOBAの平均との差を算出

#年度ごとに平均を算出
datH2_1 <-datH2 %>%
  select(年度,wOBA)%>% 
  na.omit %>%
  group_by (年度) %>%
  summarise(平均wOBA=mean(wOBA))

#元のデータと結合する
datH2_2 <- left_join(datH2, datH2_1, by = "年度")

#平均との差を算出
datH2_3<-datH2_2 %>% 
  mutate(wOBAの差=wOBA-平均wOBA)

次に選手ごとにキャリアの最高値と最低値を算出し、最高値を1、最低値が0になるように計算し直します。このとき1年しか成績のない選手は除きます。

キャリアの最高値と最低値を算出

datH2_4 <-datH2_3 %>%
  group_by (選手名) %>%
  summarise(最低wOBA=min(平均wOBAとの差),最高wOBA=max(平均wOBAとの差),出場年=n())

#元のデータと結合
datH2_5 <- left_join(datH2_3, datH2_4, by = "選手名")

#最高値を1、最低値が0になるように計算
datH2_6<-datH2_5 %>% 
  mutate(補正wOBA=平均wOBAとの差-最低wOBA,wOBAのレンジ=最高wOBA-最低wOBA) %>% 
  mutate(相対wOBA=補正wOBA/wOBAのレンジ) %>% 
  filter(出場年>=2)

グラフに描画

ggplot(data=datH2_6,aes(x=年齢2,y=相対wOBA))+
  geom_point()+labs(x="年齢",y="相対wOBA")+
  scale_x_continuous(breaks = seq(min(datH2_6$年齢2),max(datH2_6$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

27歳あたりがピークになってますね。かなり分析結果と近い値になってます。
上手く補正できたのではないでしょうか。

打てなければ出してもらえないので単純に打席数で見てみればよいのではと思ってやってみたらきれいな釣り鐘型になりました。

年齢と合計打席数

ggplot(data=datH6,aes(x=年齢2,y=合計打席数))+
  geom_point()+labs(x="年齢",y="合計打席数")+
  scale_x_continuous(breaks = seq(min(datH6$年齢2),max(datH6$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

これもかなり分析結果と近い値になってます。
こうなるともうセイバーメトリクスではないですが笑
各年齢の人数も見てみます。

年齢と選手数

ggplot(data=datH6,aes(x=年齢2,y=人数))+
  geom_point()+labs(x="年齢",y="人数")+
  scale_x_continuous(breaks = seq(min(datH6$年齢2),max(datH6$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

26～27歳がピークですかね。
いずれにせよ20代後半の選手の出場機会が多くなっているように見えます。

投手の方も見ていきます。

datP<-read.xlsx("C:/Users/ユーザー名/Downloads/pitcher_data.xlsx",sheet="Sheet1")
head(datP)

> head(datP)
                          選手名 生年月日     投打 投 打 守備       出身地 身長 血液 体重 年俸
1 ウォーランド(れすうぉーらんど)    28071 左投左打 左 左 投手     アメリカ  191 不明   93 7000
2         グリン(らいあんぐりん)    27334 右投右打 右 右 投手     アメリカ  190 不明   89 8400
3     マストニー(とむますとにー)    29621 右投右打 右 右 投手 インドネシア  198 不明  100 8000
4           阿斗里(おおたあとり)    32732 右投右打 右 右 投手         沖縄  190    A   95  580
5       横山道哉(よこやまゆきや)    28277 右投右打 右 右 投手       神奈川  190    A   98 2500
6       加藤康介(かとうこうすけ)    28673 左投左打 左 左 投手         静岡  181    O   83  960
  年度   リーグ 球団 試合 勝利 敗北 セーブ ホールド HP 完投 完封勝 無四球 打者  投球回 被安打
1 2009 セリーグ 横浜   21    5   10      0       NA NA    1      0      0  505 110.666    128
2 2009 セリーグ 横浜   23    3   15      0       NA NA    0      0      0  521 118.000    135
3 2009 セリーグ 横浜   15    1    5      0       NA NA    0      0      0  296  61.666     79
4 2009 セリーグ 横浜    1    0    0      0       NA NA    0      0      0   11   2.000      2
5 2009 セリーグ 横浜   14    0    0      0       NA NA    0      0      0   66  15.000     19
6 2009 セリーグ 横浜   31    1    0      0       NA NA    0      0      0  127  29.333     21
  被本塁打 与四球 与死球 奪三振 暴投 ボーク 失点 自責点 防御率 WHIP
1       10     50      4     85    4      1   63     59   4.80 1.61
2       17     35      4     69    5      3   73     67   5.11 1.44
3        8     25     11     43    6      0   45     39   5.69 1.69
4        0      2      0      1    1      0    1      1   4.50 2.00
5        2      4      0     12    0      0    9      8   4.80 1.53
6        5     18      2     37    1      0   13     12   3.68 1.33

打者と同じようにデータを加工していきます。

#生年月日のデータを加工する
datP<-datP %>% 
  mutate(生年月日=as.Date(生年月日, origin = "1899-12-30"))  %>% 
  mutate(生年=year(生年月日)) %>% 
  mutate(生月=month(生年月日))

#スタッツを追加する
datP2<-datP %>% 
  mutate(年齢=年度-生年)%>%

#年齢を補正する
datP2<-datP2 %>% 
  mutate(年齢2=if_else(生月>=10, true = 年齢-1,false = 年齢))

もうなんとなくわかってきましたが一応見ていきます。

年齢と防御率

ggplot(data=datP2,aes(x=年齢2,y=防御率))+
  geom_point()+labs(x="年齢",y="防御率")+
  scale_x_continuous(breaks = seq(min(datP2$年齢2),max(datP2$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

年齢と防御率（10までで拡大）

ggplot(data=datP2,aes(x=年齢2,y=防御率))+
  geom_point()+labs(x="年齢",y="防御率")+
  scale_x_continuous(breaks = seq(min(datP2$年齢2),max(datP2$年齢2),by = 1),minor_breaks = NULL)+
  coord_cartesian(ylim = c(0, 10))+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

24歳くらいからほぼ5くらいで一定ですね。野手と同じく長く活躍できている選手のデータに引っ張られている感じがします。やはり指標をそのまま使うのは厳しいですね。

野手のwOBAと同じように補正していきます。

防御率を0～1で補正

datP2_1 <-datP2 %>%
  select(年度,防御率)%>% 
  na.omit %>%
  group_by (年度) %>%
  summarise(平均防御率=mean(防御率))

datP2_2 <- left_join(datP2, datP2_1, by = "年度")

datP2_3<-datP2_2 %>% 
  mutate(平均防御率との差=防御率-平均防御率) 

datP2_4 <-datP2_3 %>%
  group_by (選手名) %>%
  summarise(最低防御率=min(平均防御率との差),最高防御率=max(平均防御率との差),出場年=n())

datP2_5 <- left_join(datP2_3, datP2_4, by = "選手名")

datP2_6<-datP2_5 %>% 
  mutate(補正防御率=平均防御率との差-最低防御率,防御率のレンジ=最高防御率-最低防御率) %>% 
  mutate(相対防御率=補正防御率/防御率のレンジ) %>% 
  filter(出場年>=2)

#グラフに描画
ggplot(data=datP2_6,aes(x=年齢2,y=相対防御率))+
  geom_point()+labs(x="年齢",y="相対防御率")+
  scale_x_continuous(breaks = seq(min(datP2_6$年齢2),max(datP2_6$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

24～25歳がピークという結果になりました。
野手と比べるとちょっと早めかなという感じですが、防御率が21歳がピークというセイバーメトリクス入門の分析結果とは3歳分くらい違いがありますね。

投球回を見てみます。

年齢と合計投球回

datP6 <-datP2 %>%
  group_by (年齢2) %>%
  summarise(合計投球回=sum(投球回),人数=n()) 

ggplot(data=datP6,aes(x=年齢2,y=合計投球回))+
  geom_point()+labs(x="年齢",y="合計投球回")+
  scale_x_continuous(breaks = seq(min(datP6$年齢2),max(datP6$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

27歳がピークですね。
人数も見てみます。

年齢と選手数

ggplot(data=datP6,aes(x=年齢2,y=人数))+
  geom_point()+labs(x="年齢",y="人数")+
  scale_x_continuous(breaks = seq(min(datP6$年齢2),max(datP6$年齢2),by = 1),minor_breaks = NULL)+
  geom_smooth(method = "lm", formula = y ~ splines::bs(x, 6))+
  theme_bw()

26歳ちょっとがピークでしょうか。
カープの投手の回で見たのは一流の選手が多いのでそこまで極端な感じはしませんでしたが、投手の場合、高卒でいきなり1軍で投げるような選手は甲子園で活躍した選手達でほぼほぼ完成しているような選手が多い気しますし、大卒即戦力とか言われて入ってくる選手も多いので、野手と比べると若いうちから活躍している選手が多い気がします。

とはいえ、実際には26歳前後の選手が多く出場しているわけなので、やっぱり21歳がピークというのは気になります。

ちょっと気になっていたのが早生まれの選手が少ないという情報です。
せっかくデータがあるので調べてみました。

野手を重複を省いて生まれた月で集計

datH7<- datH2%>% 
  distinct(選手名, .keep_all=T) %>% 
  group_by (生月) %>%
  summarise(人数=n()) 

ggplot(data=datH7,aes(x=as.factor(生月),y=人数))+
  geom_bar(stat = "identity")+labs(x="生まれ月",y="人数")+
  theme_bw()

圧倒的に4月～8月ぐらいの生まれが多いですね。
20歳くらいにもなれば生まれたタイミングなんてほとんど差なさそうな気がしますが、やっぱり早生まれは不利なのかもしれません。しかしここまでとは。

投手も見てみます。

投手を重複を省いて生まれた月で集計

datP7<- datP2%>% 
  distinct(選手名, .keep_all=T) %>% 
  group_by (生月) %>%
  summarise(人数=n()) 

ggplot(data=datP7,aes(x=as.factor(生月),y=人数))+
  geom_bar(stat = "identity")+labs(x="生まれ月",y="人数")+
  theme_bw()

野手ほどの差はないですがそれでも2～3月は少ないですね。