Shiny app to compare career trajectories of HOF candidates with contemporary players already in the HOF.

app.R

library(dplyr)
library(ggplot2)
library(geomtextpath)
library(readr)

# datasets are read from a Github respository
fg_batting <- read_csv("https://raw.githubusercontent.com/bayesball/HomeRuns2021/main/fgbatting_complete.csv")
hof <- read_csv("https://raw.githubusercontent.com/bayesball/HomeRuns2021/main/hofdata.csv")
hof_candidates <- read_csv("https://raw.githubusercontent.com/bayesball/HomeRuns2021/main/hofdata_candidates.csv")
hof_cand_batting <- filter(hof_candidates,
                           playerType == "Batter")

# plotting function for trajectories
compare_batting <- function(fg_batting,
                            playerid_vector,
                            measure, xvar,
                            mysubtitle){
  # get data for players of interest
  fg_batting %>%
    filter(key_bbref %in%
             playerid_vector) -> fg_subset
  
  measure_label <- measure
  if(measure == "wRC+"){
    measure <- "wRC_plus"
  }
  ggplot(fg_subset,
         aes_string(xvar, measure,
                    color = quote(Name),
                    label = quote(Name))) +
    geom_textsmooth(se = FALSE,
                    method = "loess",
                    formula = "y ~ x") +
    labs(title = paste(measure_label,
                       "Career Trajectories"),
         subtitle = mysubtitle) +
    ylab(measure_label) +
    theme(text = element_text(size = 15),
          plot.title = element_text(colour = "red",
                                    size = 18,
                                    hjust = 0.5,
                                    vjust = 0.8,
                                    angle = 0),
          plot.subtitle = element_text(colour = "blue",
                                    size = 16,
                                    hjust = 0.5,
                                    vjust = 0.8,
                                    angle = 0)) +
    theme(legend.position = "none")
}

# function that finds the data for the comparison of 
# the HOF candidate with the contemporary hitters
compare_HOF_candidate <- function(player_name,
                                  delta,
                                  measure, xvar){
  
  player_id <- filter(hof_candidates,
                      Name == player_name) %>% 
    pull(bbrefID)
  midseason_c <- filter(hof_candidates,
                        Name == player_name) %>% 
    pull(MidSeason)
  hof %>% 
    filter(playerType == "Batter") %>% 
    filter(abs(MidSeason - midseason_c) <= delta)  %>% 
    pull(playerid) -> 
    hof_selected  
  N <- length(hof_selected)
  
  mysubtitle <- paste("Comparing", player_name,
                      "with", N, "Contemporary HOFers")
  compare_batting(fg_batting,
                  c(hof_selected, player_id), 
                  measure, xvar,
                  mysubtitle)
}

# Shiny functions
ui <- fluidPage(
  theme = shinythemes::shinytheme("slate"),
  h2("2022 Contemporary Baseball Era Candidate Batting Trajectories"),
  column(3,
  selectInput("player",
              "Select HOF Candidate:",
              hof_cand_batting$Name),
  sliderInput("delta", 
              "Select Delta of Mid Season:",
              0, 5, 
              step = 0.5,
              value = 2),
  selectInput("measure",
               "Select Measure:",
               c("PA", "HR",
                 "BB_Pct", "K_Pct", "BABIP", "OBP",
                 "wRC+", "SLG", "wOBA",
                 "Off", "Def", "WAR"),
               selected = "WAR"),
  radioButtons("xvar",
               "Plot Against:",
               c("Season", "Age"),
               inline = TRUE)
  ),
  column(9,
         plotOutput("plot1",
                    height = '500px'))
)

server <- function(input, output, session) {
  options(warn=-1)

  output$plot1 <- renderPlot({
    compare_HOF_candidate(input$player,
                          input$delta,
                          input$measure, 
                          input$xvar)
  }, res = 96)
}

shinyApp(ui = ui, server = server)