View Single Post
Old 04-06-2019, 02:22 PM   #676
stealofhome
Hall Of Famer
 
stealofhome's Avatar
 
Join Date: Apr 2014
Posts: 2,282
Blog Entries: 1
Automatic all-star selection

I've been thinking about how to automatically complete the all-star voting with the way I would prefer to do it instead of the way the game does it. This is what I have for the NCAA. It takes into account the WAR, WPA, and POT of each player (since feeder players don't have any national popularity):

Code:
#library(readr)
#library(dplyr)
#library(tidyr)
#library(Hmisc)
#teams <- read_csv("Out of the Park Developments/OOTP Baseball 19/saved_games/OOTPLeagueReborn.lg/import_export/general/teams.csv")
#pos <- data.frame("posnum" = c(1,2,3,4,5,6,7,8,9),"posval" = c("P","C","1B","2B","3B","SS","LF","CF","RF"))

#import data (players_basic, players_value, players_career_pitching_stats, players_career_batting_stats)
players <- read_csv("Out of the Park Developments/OOTP Baseball 19/saved_games/OOTPLeagueReborn.lg/import_export/csv/players.csv")
players <- unite(players, name, c("first_name","last_name"), sep = " ")
players_career_pitching_stats <- read_csv("Out of the Park Developments/OOTP Baseball 19/saved_games/OOTPLeagueReborn.lg/import_export/csv/players_career_pitching_stats.csv")
players_value <- read_csv("Out of the Park Developments/OOTP Baseball 19/saved_games/OOTPLeagueReborn.lg/import_export/csv/players_value.csv")
players_career_batting_stats <- read_csv("Out of the Park Developments/OOTP Baseball 19/saved_games/OOTPLeagueReborn.lg/import_export/csv/players_career_batting_stats.csv")

#Reduce pitching data to NCAA in current year
pas <- players_career_pitching_stats %>% 
  select(player_id, year, league_id,split_id, bf, ip, gs, wpa, war) %>% 
  filter(league_id=='208' & split_id=='1'& year==max(year)) %>%
  merge(players[ , c("player_id", "name")], by = "player_id") %>% 
  merge(players_value[ , c("player_id", "pot")], by = "player_id")

#Compute avg/sd of WPA, WAR, and POT weighted by batters faced
pwpaavg <- weighted.mean(pas$wpa, pas$bf)
pwaravg <- weighted.mean(pas$war, pas$bf)
ppotavg <- weighted.mean(pas$pot, pas$bf)
pwpasd <- sqrt(wtd.var(pas$wpa, weights = pas$bf))
pwarsd <- sqrt(wtd.var(pas$war, weights = pas$bf))
ppotsd <- sqrt(wtd.var(pas$pot, weights = pas$bf))

#z-scores for sp and rp
pas <- pas %>% 
  mutate(sprank = (wpa-pwpaavg)/pwpasd+2*((war-pwaravg)/pwarsd)+(pot-ppotavg)/ppotsd,
         rprank = 2*((wpa-pwpaavg)/pwpasd)+(war-pwaravg)/pwarsd+2*((pot-ppotavg)/ppotsd))

#select top 12 SP and top 4 RP
AS <- pas %>% 
  filter(gs!='0') %>% 
  select(player_id, name, sprank, war) %>% 
  arrange(desc(sprank)) %>% 
  top_n(12,sprank) %>% 
  mutate(pos="SP", team=c(1,2,1,2,1,2,1,2,1,2,1,2)) %>% 
  rename(rank = sprank)

AS <- pas %>% 
  filter(gs=='0' & wpa>'0') %>% 
  select(player_id, name, rprank, war) %>% 
  arrange(desc(rprank)) %>% 
  top_n(4,rprank) %>% 
  mutate(pos="RP", team=c(1,2,1,2)) %>% 
  rename(rank = rprank) %>% 
  bind_rows(AS, .)

#Filter batter data
bas <- players_career_batting_stats %>% 
  select(player_id, year, league_id, split_id, pa, wpa, war) %>% 
  filter(league_id=='208' & split_id=='1'& year==max(year)) %>%
  merge(players[ , c("player_id", "name", "position")], by = "player_id") %>% 
  merge(players_value[ , c("player_id", "pot")], by = "player_id")

#Compute avg/sd of WPA, WAR, and POT weighted by plate appearances
bwpaavg <- weighted.mean(bas$wpa, bas$pa)
bwaravg <- weighted.mean(bas$war, bas$pa)
bpotavg <- weighted.mean(bas$pot, bas$pa)
bwpasd <- sqrt(wtd.var(bas$wpa, weights = bas$pa))
bwarsd <- sqrt(wtd.var(bas$war, weights = bas$pa))
bpotsd <- sqrt(wtd.var(bas$pot, weights = bas$pa))

#z-scores for hitters
bas <- bas %>% 
  mutate(brank = (wpa-bwpaavg)/bwpasd+3*((war-bwaravg)/bwarsd)+(pot-bpotavg)/bpotsd)

#select top 4 C and top 2 for every other position, alternate between team 1 and 2
AS <- bas %>% 
  filter(position=='2') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(4,brank) %>% 
  mutate(pos="C", team=c(1,2,1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

AS <- bas %>% 
  filter(position=='3') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(2,brank) %>% 
  mutate(pos="1B", team=c(1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

AS <- bas %>% 
  filter(position=='4') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(2,brank) %>% 
  mutate(pos="2B", team=c(1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

AS <- bas %>% 
  filter(position=='5') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(2,brank) %>% 
  mutate(pos="3B", team=c(1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

AS <- bas %>% 
  filter(position=='6') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(2,brank) %>% 
  mutate(pos="SS", team=c(1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

AS <- bas %>% 
  filter(position=='7') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(2,brank) %>% 
  mutate(pos="LF", team=c(1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

AS <- bas %>% 
  filter(position=='8') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(2,brank) %>% 
  mutate(pos="CF", team=c(1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

AS <- bas %>% 
  filter(position=='9') %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(2,brank) %>% 
  mutate(pos="RF", team=c(1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

#filter out hitters already selected to all-star game
lasth <- anti_join(bas, AS, by=c("brank"= "rank"))

#select top 6 players not already selected
AS <- lasth %>% 
  select(player_id, name, brank, war) %>% 
  arrange(desc(brank)) %>% 
  top_n(6,brank) %>% 
  mutate(pos="H", team=c(1,2,1,2,1,2)) %>% 
  rename(rank = brank) %>% 
  bind_rows(AS, .)

#create team 1 table for export to forum
AS1 <- AS %>% 
  filter(team=='1') %>%
  select(player_id, name, war) %>% 
  merge(players[ , c("player_id", "position", "team_id")], by = "player_id") %>%
  merge(pos[ , c("posnum","posval")], by.x='position', by.y = 'posnum') %>%
  merge(teams[ , c("team_id", "abbr")], by = "team_id") %>% 
  select(c(6,4,5,7)) %>% 
  mutate(war = round(war, digits = 2)) %>% 
  rename(position = posval, school = abbr) %>% 
  arrange(desc(war))

#create team 2 table for export to forum
AS2 <- AS %>% 
  filter(team=='2') %>%
  select(player_id, name, war) %>% 
  merge(players[ , c("player_id", "position", "team_id")], by = "player_id") %>%
  merge(pos[ , c("posnum","posval")], by.x='position', by.y = 'posnum') %>%
  merge(teams[ , c("team_id", "abbr")], by = "team_id") %>% 
  select(c(6,4,5,7)) %>% 
  mutate(war = round(war, digits = 2)) %>% 
  rename(position = posval, school = abbr) %>% 
  arrange(desc(war))

#Create tables to use for in-game voting
bas <- AS %>% 
  filter(pos != 'SP' , pos != 'RP') %>% 
  merge(bas[ , c("player_id", "pa")], by = "player_id") %>%
  separate(name, c("first","last"), sep = " ") %>% 
  arrange(last) %>% 
  unite("name", c("first", "last"), sep = " ") %>% 
  select(name, team, pa)

pas <- AS %>% 
  filter(pos == 'SP' | pos == 'RP') %>% 
  merge(pas[ , c("player_id", "ip")], by = "player_id") %>%
  separate(name, c("first","last"), sep = " ") %>% 
  arrange(last) %>% 
  unite("name", c("first", "last"), sep = " ") %>% 
  select(name, team, ip)

View(bas)
View(pas)

#send team 1 and 2 tables to clipboard
#write_clip(AS1)
#write_clip(AS2)

Last edited by stealofhome; 04-06-2019 at 11:20 PM.
stealofhome is offline   Reply With Quote