7.6 Modeling Catcher Framing

taken <- taken |>
  filter(
    is.na(plate_x) == FALSE,
    is.na(plate_z) == FALSE
  ) |> 
  mutate(
    strike_prob = predict(
      strike_mod, 
      type = "response"
    )
  )

\[\log \frac{p_j}{1 - p_j} = \beta_0 + \beta_1 \cdot strike\_prob_j + \alpha_{c(j)}\]

We fit a generalized linear mixed model using fixed effects from the catcher.

library(lme4)
mod_a <- glmer(
  Outcome == "called_strike" ~ 
    strike_prob + (1|fielder_2_1),
  data = taken, 
  family = binomial
)

fixed.effects(mod_a)

# (Intercept) strike_prob 
#       -4.00        7.67 

VarCorr(mod_a)

# Groups      Name        Std.Dev.
#  fielder_2_1 (Intercept) 0.218  

c_effects <- mod_a |>
  ranef() |>
  as_tibble() |>
  transmute(
    id = as.numeric(levels(grp)), 
    effect = condval
  )

master_id <- baseballr::chadwick_player_lu() |> 
  mutate(
    mlb_name = paste(name_first, name_last),
    mlb_id = key_mlbam
  ) |> 
  select(mlb_id, mlb_name) |> 
  filter(!is.na(mlb_id))

c_effects <- c_effects |>
  left_join(
    select(master_id, mlb_id, mlb_name),
    join_by(id == mlb_id)
  ) |>
  arrange(desc(effect))

c_effects |> slice_head(n = 6)

# A tibble: 6 × 3
#       id effect mlb_name         
#    <dbl>  <dbl> <chr>            
# 1 664848  0.358 Donny Sands      
# 2 669004  0.294 MJ Melendez      
# 3 642020  0.287 Chuckie Robinson 
# 4 672832  0.275 Israel Pineda    
# 5 571912  0.260 Luke Maile       
# 6 575929  0.243 Willson Contreras

c_effects |> slice_tail(n = 6)

# A tibble: 6 × 3
#       id effect mlb_name         
#    <dbl>  <dbl> <chr>            
# 1 664731 -0.293 P. J. Higgins    
# 2 455139 -0.304 Robinson Chirinos
# 3 661388 -0.336 William Contreras
# 4 608360 -0.357 Chris Okey       
# 5 435559 -0.357 Kurt Suzuki      
# 6 595956 -0.390 Cam Gallagher  

\[\log \frac{p_j}{1 - p_j} = \beta_0 + \beta_1 strike\_prob_j + \alpha_{c(j)} + \gamma_{p(j)} + \delta_{b(j)}\]

We add to the model with pitcher and batter effects.

mod_b <- glmer(
  Outcome == "called_strike" ~ strike_prob + 
    (1|fielder_2_1) +
    (1|batter) + (1|pitcher),
  data = taken, 
  family = binomial
)

VarCorr(mod_b)

# Groups      Name        Std.Dev.
#  pitcher     (Intercept) 0.267   
#  batter      (Intercept) 0.251   
#  fielder_2_1 (Intercept) 0.209 

c_effects <- mod_b |>
  ranef() |>
  as_tibble() |>
  filter(grpvar == "fielder_2_1") |>
  transmute(
    id = as.numeric(as.character(grp)), 
    effect = condval
  )
c_effects <- c_effects |>
  left_join(
    select(master_id, mlb_id, mlb_name),
    join_by(id == mlb_id)
  ) |>
  arrange(desc(effect))

c_effects |> slice_head(n = 6)

# A tibble: 6 × 3
#       id effect mlb_name       
#    <dbl>  <dbl> <chr>          
# 1 624431  0.313 Jose Trevino   
# 2 669221  0.277 Sean Murphy    
# 3 425877  0.263 Yadier Molina  
# 4 664874  0.253 Seby Zavala    
# 5 543309  0.229 Kyle Higashioka
# 6 608700  0.221 Kevin Plawecki 

c_effects |> slice_tail(n = 6)

# A tibble: 6 × 3
#       id effect mlb_name         
#    <dbl>  <dbl> <chr>            
# 1 596117 -0.277 Garrett Stubbs   
# 2 435559 -0.281 Kurt Suzuki      
# 3 521692 -0.291 Salvador Perez   
# 4 553869 -0.327 Elias Díaz       
# 5 455139 -0.336 Robinson Chirinos
# 6 669004 -0.347 MJ Melendez