Hall Of Famer
Join Date: Apr 2014
Posts: 2,282
|
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.
|