Best 100-PA Stretches Markdown
Chris Abraham
2024-05-24
# had to install this way due to a change in statcast functions
#devtools::install_github("BillPetti/baseballr")
library(baseballr)
library(dplyr)
library(ggplot2)
##### FIRST DECIDE WHICH PLAYERS' ATBAT DATA WE WANT TO DOWNLOAD
### LET'S TAKE THE 2023 Top players for Total Bases, and All of Cleveland's 2024 Hitters
top_total_bases_2023=mlb_stats_leaders(leader_categories = 'totalBases',
sport_id=1,
stat_group='hitting',
season=2023)
cleveland_hitters_2024=mlb_team_leaders(team_id=114, #cleveland's ID number
leader_categories='totalBases',
season=2024
) %>%
filter(stat_group=='hitting')
glimpse(top_total_bases_2023) ## Rows: 102
## Columns: 23
## $ leader_category <chr> "totalBases", "totalBases", "totalBases", "total…
## $ rank <int> 1, 2, 3, 4, 5, 6, 7, 8, 8, 10, 11, 12, 12, 14, 1…
## $ value <chr> "383", "367", "361", "338", "328", "325", "320",…
## $ season <chr> "2023", "2023", "2023", "2023", "2023", "2023", …
## $ num_teams <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ team_id <int> 144, 144, 119, 119, 144, 108, 140, 136, 118, 144…
## $ team_name <chr> "Atlanta Braves", "Atlanta Braves", "Los Angeles…
## $ team_link <chr> "/api/v1/teams/144", "/api/v1/teams/144", "/api/…
## $ league_id <int> 104, 104, 104, 104, 104, 103, 103, 103, 103, 104…
## $ league_name <chr> "NL", "NL", "NL", "NL", "NL", "AL", "AL", "AL", …
## $ league_link <chr> "/api/v1/league/104", "/api/v1/league/104", "/ap…
## $ person_id <int> 660670, 621566, 518692, 605141, 663586, 660271, …
## $ person_full_name <chr> "Ronald Acuña Jr.", "Matt Olson", "Freddie Freem…
## $ person_link <chr> "/api/v1/people/660670", "/api/v1/people/621566"…
## $ person_first_name <chr> "Ronald", "Matt", "Freddie", "Mookie", "Austin",…
## $ person_last_name <chr> "Acuña", "Olson", "Freeman", "Betts", "Riley", "…
## $ sport_id <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ sport_link <chr> "/api/v1/sports/1", "/api/v1/sports/1", "/api/v1…
## $ sport_abbreviation <chr> "MLB", "MLB", "MLB", "MLB", "MLB", "MLB", "MLB",…
## $ stat_group <chr> "hitting", "hitting", "hitting", "hitting", "hit…
## $ total_splits <int> 633, 633, 633, 633, 633, 633, 633, 633, 633, 633…
## $ game_type_id <chr> "R", "R", "R", "R", "R", "R", "R", "R", "R", "R"…
## $ game_type_description <chr> "Regular Season", "Regular Season", "Regular Sea…glimpse(cleveland_hitters_2024) ## Rows: 15
## Columns: 22
## $ leader_category <chr> "totalBases", "totalBases", "totalBases", "total…
## $ rank <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
## $ value <chr> "98", "86", "71", "66", "54", "53", "49", "37", …
## $ season <chr> "2024", "2024", "2024", "2024", "2024", "2024", …
## $ team_id <int> 114, 114, 114, 114, 114, 114, 114, 114, 114, 114…
## $ team_name <chr> "Cleveland Guardians", "Cleveland Guardians", "C…
## $ team_link <chr> "/api/v1/teams/114", "/api/v1/teams/114", "/api/…
## $ league_id <int> 103, 103, 103, 103, 103, 103, 103, 103, 103, 103…
## $ league_name <chr> "AL", "AL", "AL", "AL", "AL", "AL", "AL", "AL", …
## $ league_link <chr> "/api/v1/league/103", "/api/v1/league/103", "/ap…
## $ person_id <int> 608070, 647304, 665926, 680757, 686823, 671289, …
## $ person_full_name <chr> "José RamÃrez", "Josh Naylor", "Andrés Giménez",…
## $ person_link <chr> "/api/v1/people/608070", "/api/v1/people/647304"…
## $ person_first_name <chr> "José", "Josh", "Andrés", "Steven", "Will", "Tyl…
## $ person_last_name <chr> "RamÃrez", "Naylor", "Giménez", "Kwan", "Brennan…
## $ sport_id <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
## $ sport_link <chr> "/api/v1/sports/1", "/api/v1/sports/1", "/api/v1…
## $ sport_abbreviation <chr> "MLB", "MLB", "MLB", "MLB", "MLB", "MLB", "MLB",…
## $ stat_group <chr> "hitting", "hitting", "hitting", "hitting", "hit…
## $ total_splits <int> 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, …
## $ game_type_id <chr> "R", "R", "R", "R", "R", "R", "R", "R", "R", "R"…
## $ game_type_description <chr> "Regular Season", "Regular Season", "Regular Sea…### Grab the player info (player Id, name, debut date ) for the group of players above
player_ids=rbind(top_total_bases_2023 %>% select(person_id),
cleveland_hitters_2024 %>% select(person_id)) %>%
distinct(person_id)
head(player_ids)## person_id
## 1: 660670
## 2: 621566
## 3: 518692
## 4: 605141
## 5: 663586
## 6: 660271function_player_db=function(x) mlb_people(person_ids=x) %>%
select(id, full_name, mlb_debut_date, active)
library(data.table)
player_db=rbindlist(lapply(player_ids$person_id, function_player_db))
head(player_db)## id full_name mlb_debut_date active
## 1: 660670 Ronald Acuña Jr. 2018-04-25 TRUE
## 2: 621566 Matt Olson 2016-09-12 TRUE
## 3: 518692 Freddie Freeman 2010-09-01 TRUE
## 4: 605141 Mookie Betts 2014-06-29 TRUE
## 5: 663586 Austin Riley 2019-05-15 TRUE
## 6: 660271 Shohei Ohtani 2018-03-29 TRUE#for each player, I have to give a date range for which to pull statcast_data from
# so I am going to make a data fram with start and end dates, then join it to player_db
first_debut=year(min(player_db$mlb_debut_date))
library(tidyr)
start_end_years_dates=data.frame(crossing(startyear=c(first_debut:2024),
endyear=c(first_debut:2024)) ) %>%
filter(endyear>=startyear) %>%
mutate(start_date=paste(endyear,"-03-01", sep=""),
end_date=paste(endyear, "-11-10", sep=""))
head(start_end_years_dates)## startyear endyear start_date end_date
## 1 2009 2009 2009-03-01 2009-11-10
## 2 2009 2010 2010-03-01 2010-11-10
## 3 2009 2011 2011-03-01 2011-11-10
## 4 2009 2012 2012-03-01 2012-11-10
## 5 2009 2013 2013-03-01 2013-11-10
## 6 2009 2014 2014-03-01 2014-11-10## Now join apppend this table to player_db (each player will have a row for each year he played in)
#the warning message will state that multiple matches are made--that is what we want
player_db2=player_db %>% mutate(debut_year=year(mlb_debut_date)) %>%
left_join(start_end_years_dates, by=c('debut_year'='startyear')) %>%
mutate(start_date=if_else(year(mlb_debut_date)==endyear, mlb_debut_date, start_date))## Warning in left_join(., start_end_years_dates, by = c(debut_year = "startyear")): Each row in `x` is expected to match at most 1 row in `y`.
## ℹ Row 1 of `x` matches multiple rows.
## ℹ If multiple matches are expected, set `multiple = "all"` to silence this
## warning.head(player_db2)## id full_name mlb_debut_date active debut_year endyear start_date
## 1: 660670 Ronald Acuña Jr. 2018-04-25 TRUE 2018 2018 2018-04-25
## 2: 660670 Ronald Acuña Jr. 2018-04-25 TRUE 2018 2019 2019-03-01
## 3: 660670 Ronald Acuña Jr. 2018-04-25 TRUE 2018 2020 2020-03-01
## 4: 660670 Ronald Acuña Jr. 2018-04-25 TRUE 2018 2021 2021-03-01
## 5: 660670 Ronald Acuña Jr. 2018-04-25 TRUE 2018 2022 2022-03-01
## 6: 660670 Ronald Acuña Jr. 2018-04-25 TRUE 2018 2023 2023-03-01
## end_date
## 1: 2018-11-10
## 2: 2019-11-10
## 3: 2020-11-10
## 4: 2021-11-10
## 5: 2022-11-10
## 6: 2023-11-10### Now we can grab the atbat data for each player between his start_date and end_date
function_atbatdata=function(x,y,z) scrape_statcast_savant_batter(as.Date(x),as.Date(y),
batterid=z)
t=function_atbatdata("2024-05-12", "2024-05-21", 660670)
# ^^ this was just an example of one player's data pull between two datesI am not going to run this in the Markdown, because it took about 2 hours to run. But this will grab every player’s (in our player_db) at bat data for his ENTIRE CAREER!
#this may take a while to run, it is pulling a dataframe for each unique row in player_db2
# you can restrict your desired players and date ranges how you wish
# you just need to run scrape_statcast_savant_batter(as.Date(x),as.Date(y),batterid=z)
atbatlist=mapply(function_atbatdata, player_db2$start_date, player_db2$end_date, player_db2$id)
atbatlist_rowsofinterest=subset(atbatlist,
rownames(atbatlist) %in% c('game_date', 'pitch_type', 'pitch_name',
'pitch_number',
'release_speed', 'batter', 'player_name',
'events', 'description',
'hit_distance_sc', 'launch_angle', 'launch_speed',
'at_bat_number'))
#now take all of the 900+ dataframes stores in the atbatlist
#bind them together
#choose only the rows where there is an event (i.e. dont pick "Strike 1")
# select just a few of the 180+ columns
#Group by player, and order their at-bats (this will allow for running totals)
func_dataframe=function(x) as.data.frame(atbatlist_rowsofinterest[,x])
big_atbat_df=plyr::rbind.fill(
lapply(1:length(colnames(atbatlist_rowsofinterest)), func_dataframe)) %>%
filter(events!='') %>%
### We have to remove events that dont signify a PLATE APP (caught stealing, pickoff attempts, etc)
filter(!grepl('pickoff|other_out|wild_pitch|stolen_base|game_advisory|passed_ball|caught_stealing', events)) %>%
arrange(batter, game_date, at_bat_number ) %>%
select(game_date, pitch_type, pitch_name, pitch_number,
release_speed, batter, player_name, events, description,
hit_distance_sc, launch_angle, launch_speed, at_bat_number) %>%
rename(ab_number_in_game=at_bat_number) %>%
group_by(batter) %>%
mutate(abnumber=row_number())Instead I will infile the big_atbat_df data set that I made above
big_atbat_df =fread('E:/R Baseball Files/Career Atbat Logs_2023s Top Hitters and CLE 24 Hitters UPDATED 2024-05-23 09_07_21.csv')
events_numerator_denom=data.frame(events=unique(big_atbat_df$events)) %>%
mutate(hit=if_else(events %in% c('single', 'double', 'triple', 'home_run'), 1, 0)) %>%
mutate(atbats=if_else(events %in% c('single', 'double', 'triple', 'home_run',
'field_out', 'strikeout', 'force_out',
'grounded_into_double_play', 'field_error',
'double_play', 'fileders_choice', 'fielders_choice_out',
'strikeout_double_play', 'triple_play'), 1, 0)) %>%
mutate(on_base_num=if_else(events %in% c('single', 'double', 'triple', 'home_run',
'walk', 'hit_by_pitch', 'intent_walk'), 1, 0)) %>%
mutate(on_base_denom=if_else(events %in% c('single', 'double', 'triple', 'home_run',
'walk', 'hit_by_pitch', 'intent_walk', 'sac_fly',
'field_out', 'strikeout', 'force_out',
'grounded_into_double_play', 'field_error',
'double_play', 'fileders_choice', 'fielders_choice_out',
'strikeout_double_play', 'triple_play'), 1, 0)) %>%
mutate(slug_num=if_else(events %in% c('single'), 1,
if_else(events %in% c('double'), 2,
if_else(events %in% c('triple'), 3,
if_else(events %in% c('home_run'), 4, 0)))))
### Now we want to take rolling-100-AB totals for each player.
library(zoo)## Warning: package 'zoo' was built under R version 4.2.3atbats_with_rolling_totals=big_atbat_df %>%
left_join(events_numerator_denom, by=c('events')) %>%
group_by(batter) %>%
arrange(batter, abnumber) %>%
mutate(rolling_100_hit=rollsumr(hit, k = 100, fill = NA),
rolling_100_atbats=rollsumr(atbats, k = 100, fill = NA),
rolling_100_on_base_num=rollsumr(on_base_num, k = 100, fill = NA),
rolling_100_on_base_denom=rollsumr(on_base_denom, k = 100, fill = NA),
rolling_100_slug_num=rollsumr(slug_num, k = 100, fill = NA)) %>%
mutate(rolling_100_avg=rolling_100_hit/rolling_100_atbats,
rolling_100_obp=rolling_100_on_base_num/rolling_100_on_base_denom,
rolling_100_slg=rolling_100_slug_num/rolling_100_atbats,
rolling_100_ops=rolling_100_obp+rolling_100_slg)
best_stretches_byplayer=atbats_with_rolling_totals %>%
mutate(player_rolling_100_avg_rank=rank(-rolling_100_avg, ties.method='first'),
player_rolling_100_obp_rank=rank(-rolling_100_obp, ties.method='first'),
player_rolling_100_slg_rank=rank(-rolling_100_slg, ties.method='first'),
player_rolling_100_ops_rank=rank(-rolling_100_ops, ties.method='first'))
ranked_best_stretches_obp=best_stretches_byplayer %>%
filter(player_rolling_100_obp_rank==1) %>%
ungroup() %>%
mutate(player_rank_best_obp_stretch=rank(-rolling_100_obp, ties.method='min')) %>%
arrange(player_rank_best_obp_stretch)ranked_best_stretches_obp %>% filter(!is.na(rolling_100_obp)) %>%
mutate(facetgroup=if_else(player_rank_best_obp_stretch<=50, "Players 1-50", "Remaining Players"))%>%
mutate(fillvariable=if_else(batter %in% unique(cleveland_hitters_2024$person_id), "cle", "non cle")) %>%
ggplot(aes(x=reorder(player_name, rolling_100_obp), y=rolling_100_obp,
label=paste(game_date, format(round(rolling_100_obp, 3), digits=3), sep=": ")))+
geom_bar(stat='identity', aes(fill=fillvariable))+
scale_fill_manual(values=c('dodgerblue', 'grey'), guide="none")+
geom_hline(yintercept=0.4, linetype='dotted')+
geom_hline(yintercept=0.5, linetype='dotted')+
geom_hline(yintercept=0.6, linetype='dotted')+
geom_text(size=2.5, fontface='bold', color='black', hjust=1.2)+
scale_y_continuous(
labels = scales::number_format(accuracy = 0.001))+
coord_flip()+
theme_bw()+
theme(axis.text=element_text(size=6))+
facet_wrap(~facetgroup, scales='free_y')+
ggtitle('Juan Soto was in another galaxy at the end the 2021 season')+
labs(y='Best Rolling 100-PA OBP of Career', x='Player (Grouped for Aesthetic)')