Does Riley Greene Improve Other Hitters?

statistics
r
baseball
Author

Mark Jurries II

Published

September 19, 2026

I was watching the Tigers* the other night, and they got to talking about how much Riley Greene being out hurt the team. They showed some stats that seemed to support the argument - they won fewer games and scored fewer runs per game. Naturally, this got me thinking - how much of that was just due to chance? Some of their hitters haven’t exactly been lighting it up this year, so perhaps it’s just a function of that?

*I’m a sucker for punishment, it seems.

I already had a script to get boxscore data from Fangraphs, and after some back and forth with Gemini* I was able to produce a function that checks how batters perform (measured using wOBA) with and without another player in the lineup and tests that for significance. This would not only let us test Greene, but also check to see if the effect existed for any other player. We’ll only look at batters with at least 200 PA.

*At one point, Gemini asked me if I “Want to add empirical Bayes credible intervals from brms instead of Wald p-values?”, which made my day.
Show the code 
library(baseballr)
library(tidyverse)
library(brms)
library(bayestestR)
library(tidybayes)
library(scales)
library(gt)
library(hrbrthemes)
library(gtExtras)
library(ggrepel)
library(zoo)

# Set Stan options
options(mc.cores = parallel::detectCores())

season <- 2026

# ==============================================================================
# 1. SCRAPE & CONSTRUCT BOX SCORE DATASET
# ==============================================================================

mlb_batters <- fg_batter_leaders(
  startseason = season,
  endseason   = season,
  qual        = "n"
)

qual_det_batters <- mlb_batters %>%
  filter(team_name == "DET") %>%
  select(playerid, PlayerName, PA)

# Pull game logs for each batter
det_bat <- qual_det_batters %>%
  mutate(tmp_season = map(playerid, ~ fg_batter_game_logs(.x, season), .progress = TRUE))

# Unnest tmp_season cleanly without redundant coalescing
df_game_logs <- det_bat %>%
  select(tmp_season) %>%
  unnest(tmp_season) %>%
  janitor::clean_names() %>%
  mutate(
    batter_name = player_name,
    pa          = as.numeric(pa),
    ab          = as.numeric(ab),
    h           = as.numeric(h),
    doubles     = as.numeric(x2b),
    triples     = as.numeric(x3b),
    hr          = as.numeric(hr),
    bb          = as.numeric(bb),
    hbp         = as.numeric(replace_na(hbp, 0)),
    sf          = as.numeric(replace_na(sf, 0)),
    singles     = pmax(0, h - (doubles + triples + hr)),
    game_id     = paste(date, opp, sep = "_"),
    home_away   = if_else(str_detect(opp, "@"), "Away", "Home")
  ) %>%
  filter(pa > 0) %>%
  mutate(
    # Standard linear weights
    woba_numerator = (0.69 * bb) + (0.72 * hbp) + (0.88 * singles) +
      (1.25 * doubles) + (1.58 * triples) + (2.04 * hr),
    woba = woba_numerator / pa
  ) %>%
  select(game_id, batter = batter_name, pa, woba, home_away)

# ==============================================================================
# 2. BAYESIAN MODEL & ROPE EVALUATION FUNCTION
# ==============================================================================

# Priors: Baseline wOBA ~ Normal(.315, .040); Delta ~ Normal(0, .020)
brms_priors <- c(
  prior(normal(0.315, 0.040), class = "Intercept"),
  prior(normal(0.000, 0.020), class = "b", coef = "target_active"),
  prior(exponential(20),      class = "sd"),
  prior(exponential(15),      class = "sigma")
)

ROPE_LOWER <- -0.005
ROPE_UPPER <-  0.005

fit_and_test_rope <- function(target_player, logs) {
  # Flag games the target started (>= 3 PA)
  target_starts <- logs %>%
    filter(batter == target_player) %>%
    group_by(game_id) %>%
    summarize(target_started = as.integer(any(pa >= 3)), .groups = "drop")
  
  all_games <- tibble(game_id = unique(logs$game_id))
  
  presence_map <- all_games %>%
    left_join(target_starts, by = "game_id") %>%
    mutate(target_active = replace_na(target_started, 0L))
  
  # Filter out target player's own PAs to isolate the rest of the lineup
  model_data <- logs %>%
    filter(batter != target_player) %>%
    left_join(presence_map, by = "game_id")
  
  presence_counts <- table(presence_map$target_active)
  if (length(presence_counts) < 2 || min(presence_counts) < 5) {
    message(paste("Skipping", target_player, "- insufficient games with/without."))
    return(NULL)
  }
  
  # Fit precision-weighted mixed model
  fit <- brm(
    woba | resp_weights(pa) ~ target_active + home_away +
      (1 + target_active | batter) +
      (1 | game_id),
    data    = model_data,
    family  = gaussian(),
    prior   = brms_priors,
    chains  = 4,
    iter    = 2000,
    warmup  = 1000,
    control = list(adapt_delta = 0.95),
    backend = "cmdstanr",
    refresh = 0,
    silent  = 2
  )
  
  draws <- as_draws_df(fit)
  b_target <- draws$b_target_active
  
  # Calculate 95% Highest Density Interval (HDI) using explicit namespace
  hdi_res <- bayestestR::hdi(b_target, ci = 0.95)
  
  # Compute percentage of posterior mass inside the ROPE
  rope_res <- bayestestR::rope(b_target, range = c(ROPE_LOWER, ROPE_UPPER), ci = 0.95)
  
  decision <- case_when(
    hdi_res$CI_low > ROPE_UPPER | hdi_res$CI_high < ROPE_LOWER ~ "Reject Null (Real Effect)",
    hdi_res$CI_low >= ROPE_LOWER & hdi_res$CI_high <= ROPE_UPPER ~ "Accept Null (Negligible)",
    TRUE ~ "Undecided (Noisy / Underpowered)"
  )
  
  # Return both summary row and raw posterior draws for plotting
  list(
    summary = tibble(
      player        = target_player,
      woba_without  = mean(draws$b_Intercept),
      woba_with     = mean(draws$b_Intercept + b_target),
      delta         = mean(b_target),
      hdi_lower     = hdi_res$CI_low,
      hdi_upper     = hdi_res$CI_high,
      rope_pct      = rope_res$ROPE_Percentage,
      decision      = decision
    ),
    draws = tibble(
      player = target_player,
      delta  = b_target
    )
  )
}

# ==============================================================================
# 3. RUN ACROSS REGULARS (>= 200 PA)
# ==============================================================================

qualifying_players <- df_game_logs %>%
  group_by(batter) %>%
  summarize(total_pa = sum(pa), .groups = "drop") %>%
  filter(total_pa >= 200) %>%
  pull(batter)

rope_results_raw <- qualifying_players %>%
  map(fit_and_test_rope, logs = df_game_logs, .progress = TRUE) %>%
  compact()

# Separate into summary table and draw tibbles
rope_results <- map_dfr(rope_results_raw, ~ .x$summary) %>%
  arrange(desc(delta))

all_draws <- map_dfr(rope_results_raw, ~ .x$draws)

# ==============================================================================
# 4. GT TABLE
# ==============================================================================

spillover_table <- rope_results %>%
  mutate(
    hdi_formatted = sprintf("[%+.3f, %+.3f]", hdi_lower, hdi_upper)
  ) %>%
  select(
    player,
    woba_without,
    woba_with,
    delta,
    hdi_formatted,
    rope_pct,
    decision
  ) %>%
  gt() %>%
  tab_header(
    title    = md("**Detroit Tigers: Lineup Spillover Effects (ROPE Hypothesis Test)**"),
    subtitle = "Bayesian test of practical equivalence: ROPE = [-0.005, +0.005] wOBA"
  ) %>%
  cols_label(
    player        = "Player",
    woba_without  = "Rest wOBA (Without)",
    woba_with     = "Rest wOBA (With)",
    delta         = "Mean Δ wOBA",
    hdi_formatted = "95% HDI",
    rope_pct      = "% in ROPE",
    decision      = "Hypothesis Test Verdict"
  ) %>%
  fmt_number(
    columns  = c(woba_without, woba_with),
    decimals = 3
  ) %>%
  fmt_number(
    columns    = delta,
    decimals   = 3,
    force_sign = TRUE
  ) %>%
  fmt_percent(
    columns  = rope_pct,
    decimals = 1
  ) %>%
  data_color(
    columns   = delta,
    direction = "column",
    palette   = c("#B31B1B", "#FDFDFD", "#1B5E20"),
    domain    = c(-0.035, 0.035)
  ) %>%
  text_transform(
    locations = cells_body(columns = decision),
    fn = function(x) {
      map_chr(x, function(val) {
        if (str_detect(val, "Reject Null")) {
          "<span style='color: #1B5E20; font-weight: bold;'>Reject Null (Real Effect)</span>"
        } else if (str_detect(val, "Accept Null")) {
          "<span style='color: #0D47A1; font-weight: bold;'>Accept Null (Equivalent to 0)</span>"
        } else {
          "<span style='color: #757575;'>Undecided (Underpowered)</span>"
        }
      })
    }
  ) %>%
  cols_align(
    align   = "center",
    columns = c(woba_without, woba_with, delta, hdi_formatted, rope_pct, decision)
  ) %>%
  cols_align(
    align   = "left",
    columns = player
  ) %>%
  tab_source_note(
    source_note = md(
      "*Decision Rule: 95% HDI outside ROPE rejects the null; 95% HDI entirely within ROPE accepts the null; overlap is undecided. Prior: Delta ~ N(0, 0.020).*"
    )
  ) %>%
  opt_row_striping() %>%
  tab_options(
    heading.title.font.size    = px(18),
    heading.subtitle.font.size = px(13),
    column_labels.font.weight  = "bold",
    table.font.size            = px(13)
  )

# Render table
spillover_table
Detroit Tigers: Lineup Spillover Effects (ROPE Hypothesis Test)
Bayesian test of practical equivalence: ROPE = [-0.005, +0.005] wOBA
Player Rest wOBA (Without) Rest wOBA (With) Mean Δ wOBA 95% HDI % in ROPE Hypothesis Test Verdict
Riley Greene 0.280 0.296 +0.017 [-0.016, +0.049] 14.6% Undecided (Underpowered)
Kerry Carpenter 0.299 0.315 +0.016 [-0.013, +0.043] 15.7% Undecided (Underpowered)
Spencer Torkelson 0.292 0.303 +0.011 [-0.023, +0.045] 19.7% Undecided (Underpowered)
Gleyber Torres 0.300 0.311 +0.011 [-0.015, +0.039] 21.9% Undecided (Underpowered)
Zach McKinstry 0.305 0.315 +0.010 [-0.016, +0.038] 22.7% Undecided (Underpowered)
Kevin McGonigle 0.301 0.300 −0.001 [-0.037, +0.034] 22.5% Undecided (Underpowered)
Colt Keith 0.306 0.305 −0.001 [-0.031, +0.027] 27.3% Undecided (Underpowered)
Matt Vierling 0.313 0.307 −0.006 [-0.033, +0.024] 27.2% Undecided (Underpowered)
Dillon Dingler 0.307 0.300 −0.007 [-0.040, +0.023] 22.3% Undecided (Underpowered)
Hao Yu Lee 0.314 0.295 −0.019 [-0.048, +0.011] 12.2% Undecided (Underpowered)
Decision Rule: 95% HDI outside ROPE rejects the null; 95% HDI entirely within ROPE accepts the null; overlap is undecided. Prior: Delta ~ N(0, 0.020).

On the one hand, this shows that Greene does more to lift the lineup than anybody else. However; the results isn’t statistically significant. It also suggests that the team hits worse when McGonigle or Dingler are in the lineup, which wouldn’t make a lot of sense. We can visualize the differences as well:

Show the code 
# Merge summary labels into draws to create informative facet strip titles
plot_data <- all_draws %>%
  rename(draw_value = delta) %>% # Raw MCMC distribution
  left_join(
    rope_results %>%
      select(player, mean_delta = delta, rope_pct, decision), # Scalar summary
    by = "player"
  ) %>%
  mutate(
    facet_label = sprintf(
      "%s\nΔ: %+.3f | ROPE: %.0f%%",
      player, mean_delta, rope_pct * 100
    ),
    facet_label = fct_reorder(facet_label, mean_delta, .desc = TRUE)
  )

spillover_facet_plot <- ggplot(plot_data, aes(x = draw_value)) +
  annotate(
    "rect",
    xmin = ROPE_LOWER, xmax = ROPE_UPPER,
    ymin = -Inf, ymax = Inf,
    fill = "#2E7D32", alpha = 0.15
  ) +
  geom_vline(
    xintercept = 0,
    linetype   = "dashed",
    color      = "#B31B1B",
    linewidth  = 0.6
  ) +
  stat_halfeye(
    point_interval = median_hdi,
    .width         = c(0.66, 0.95),
    fill           = "#0C2340",
    color          = "#0C2340",
    alpha          = 0.85,
    size           = 1.2
  ) +
  facet_wrap(~ facet_label, scales = "free_y")

# Render plot
spillover_facet_plot+
  theme_ipsum()

This doesn’t add a lot, though it does reinforce how close some players are. Though even there, simply seeing the difference doesn’t mean it’s causal. There are a lot of interaction effects here, some measurable - home/away, pitcher handedness and quality, etc. - that we didn’t bring into this, and some, such as team chemistry, that we can’t directly measure.

As long as we have this data, we can take a quick look at Tiger batter consistency. We’ll measure their 7-game rolling wOBA and its standard deviation. A lower standard deviation means more consistency, higher means more fluctuation.

*I mean, we’re here, we may as well.
Show the code 
W_BB  <- 0.708
W_HBP <- 0.739
W_1B  <- 0.902
W_2B  <- 1.278
W_3B  <- 1.616
W_HR  <- 2.073

det_bat_long <- det_bat %>%
  filter(PA > 200) %>%
  select(tmp_season) %>%
  unnest(tmp_season) %>%
  mutate(uBB = BB - IBB)

det_bat_date <- det_bat_long %>%
  select(Date) %>%
  distinct()

det_bat_players <- det_bat_long %>%
  select(playerid, PlayerName) %>%
  distinct()

get_rolling_munged <- function(data, k_window = 7) {
  data %>%
    select(PlayerName, playerid, Date, PA, uBB, `1B`, `2B`, `3B`, HR, HBP) %>%
    arrange(playerid, Date) %>%
    group_by(playerid, PlayerName) %>%
    mutate(
      across(c(PA, uBB, `1B`, `2B`, `3B`, HR, HBP), 
             ~rollmean(.x, k = k_window, fill = NA, align = "right"), 
             .names = "rolling_{.col}")
    ) %>%
    mutate(rolling_wOBA = (
      (rolling_uBB * W_BB) + (rolling_HBP * W_HBP) + (rolling_1B * W_1B) + 
        (rolling_2B * W_2B) + (rolling_3B * W_3B) + (rolling_HR * W_HR)
    ) / rolling_PA) %>%
    ungroup()
}

det_bat_long_munged <- get_rolling_munged(det_bat_long, k_window = 7)

det_season_woba <- det_bat_long %>%
  group_by(playerid, PlayerName) %>%
  summarise(
    total_PA  = sum(PA, na.rm = TRUE),
    total_uBB = sum(uBB, na.rm = TRUE),
    total_HBP = sum(HBP, na.rm = TRUE),
    total_1B  = sum(`1B`, na.rm = TRUE),
    total_2B  = sum(`2B`, na.rm = TRUE),
    total_3B  = sum(`3B`, na.rm = TRUE),
    total_HR  = sum(HR, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  mutate(season_wOBA = (
    (total_uBB * W_BB) + (total_HBP * W_HBP) + (total_1B * W_1B) + 
      (total_2B * W_2B) + (total_3B * W_3B) + (total_HR * W_HR)
  ) / total_PA) %>%
  arrange(desc(season_wOBA))

det_bat_long_munged %>%
  group_by(playerid, PlayerName) %>%
  summarise(mean_roll = mean(rolling_wOBA, na.rm = TRUE),
            sd_roll = sd(rolling_wOBA, na.rm = TRUE)) %>%
  inner_join(det_season_woba) %>%
  arrange(desc(sd_roll)) %>%
  ggplot(aes(x = sd_roll, y = season_wOBA, label = PlayerName))+
  geom_point()+
  geom_text_repel()+
  theme_ipsum()

McGonigle and Torres are consistently good. Greene and Dingler and inconsistently good (read streaky), while Torkhas been good and middle of the pack consistency wise.

We can go a step further and chart each batter’s season to see what their peaks and valleys look like.

Show the code 
det_bat_date %>%
  cross_join(det_bat_players) %>%
  left_join(det_bat_long_munged) %>%
  inner_join(det_season_woba %>% select(playerid, season_wOBA)) %>%
  ggplot(aes(x = Date, y = rolling_wOBA, group = PlayerName))+
  geom_line()+
  geom_hline(aes(yintercept = season_wOBA), linetype = 'dashed')+
  facet_wrap(PlayerName ~ .)+
  theme_ipsum()+
  theme(axis.text.x = element_blank())

We see here why Dingler’s SD was so high - his recent slump has really brought him down. Even eyeballing it, we can see where Greene and Keith are streaky, and even McGonigle has ups and downs, though with less magnitude than most everybody else. We can also note that Dingler started to struggle around the time Greene hit the Injured List - though it’s an open question of how influential that was.