［R］Mickey Mantleの打撃成績推移（「Rによるセイバーメトリクス入門」（技術評論社）pp.184-188）

> library(tidyverse)
> library(Lahman)
> get_stats <- function(player.id) {
+ batting %>%
+ filter(playerID == player.id) %>%
+ inner_join(People, by = "playerID") %>%
+ mutate(birthyear = ifelse(birthMonth >= 7, birthYear + 1,
+   birthYear),
+    Age = yearID - birthyear,
+    SLG = (H - X2B - X3B - HR + 2 * X2B + 3 * X3B + 4 * HR) / AB,
+    OBP = (H + BB + HBP) / (AB + BB + HBP + SF),
+    OPS = SLG + OBP) %>%
+ select(Age, SLG, OBP, OPS)
+ }
> fit_model <- function(d) {
+ fit <- lm(OPS ~ I(Age - 30) + I((Age - 30) ^ 2), data = d)
+ b <- coef(fit)
+ Age.max <- 30 - b[2] / b[3] / 2
+ Max <- b[1] - b[2] ^ 2 / b[3] / 4
+ list(fit = fit, Age.max = Age.max, Max = Max)
+ }
> People %>%
+ filter(nameFirst == "Mickey", nameLast == "Mantle") %>%
+ pull(playerID) -> mantle_id
> Batting %>% replace_na(list(SF = 0, HBP = 0)) -> batting
> Mantle <- get_stats(mantle_id)
> g8_1 <- ggplot(Mantle, aes(Age, OPS)) + geom_point()
> ggsave("fig8_1.png", plot = g8_1)
Saving 7 x 7 in image
> F2 <- fit_model(Mantle)
> print(coef(F2$fit))
    (Intercept)     I(Age - 30) I((Age - 30)^2) 
    1.043134189    -0.022883024    -0.003868915 
> print(c(F2$Age.max, F2$Max))
I(Age - 30) (Intercept) 
   27.04271     1.07697 
> g8_2 <- ggplot(Mantle, aes(Age, OPS)) + geom_point() +
+ geom_smooth(method = "lm", se = FALSE, size = 1.5,
+ formula = y ~ poly(x, 2, raw= TRUE)) +
+ geom_vline(xintercept = F2$Age.max, linetype = "dashed",
+    color = "darkgrey") +
+ geom_hline(yintercept = F2$Max, linetype = "dashed", color = "darkgrey") +
+ annotate(geom = "text", x = c(29, 20), y = c(0.72, 1.1),
+  label = c("Peak age", "Max"), size = 5)
> ggsave("fig8_2.png", plot = g8_2)
Saving 7 x 7 in image
> print(F2 %>% pluck("fit") %>% summary())
Call:
lm(formula = OPS ~ I(Age - 30) + I((Age - 30)^2), data = d)
Residuals:
     Min       1Q   Median       3Q      Max 
-0.17282 -0.04010  0.02203  0.04507  0.12819 
Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)      1.0431342  0.0279009  37.387 3.19e-16 ***
I(Age - 30)     -0.0228830  0.0056381  -4.059 0.001029 ** 
I((Age - 30)^2) -0.0038689  0.0008283  -4.671 0.000302 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.08421 on 15 degrees of freedom
Multiple R-squared:  0.6018,    Adjusted R-squared:  0.5488 
F-statistic: 11.34 on 2 and 15 DF,  p-value: 0.001001

出力したfig8_1.png（図8.1）とfig8_2.png（図8.2）は以下のとおり。