Spaces:
Sleeping
Sleeping
| server <- function(input, output, session) { | |
| user_auth <- reactiveVal(FALSE) | |
| login_transition <- reactiveVal(FALSE) | |
| login_success_pending <- reactiveVal(FALSE) | |
| scores_data_rv <- reactiveVal(tibble::tibble()) | |
| scores_error_rv <- reactiveVal(NULL) | |
| standings_data_rv <- reactiveVal(tibble::tibble()) | |
| standings_error_rv <- reactiveVal(NULL) | |
| player_scope <- reactiveVal("wvu") | |
| all_conferences <- get_all_conferences() | |
| conference_game_choices <- stats::setNames(paste0("conference::", all_conferences), all_conferences) | |
| conference_standings_choices <- stats::setNames(all_conferences, all_conferences) | |
| empty_selection_lookup <- tibble::tibble( | |
| selection_id = character(), | |
| player_name = character(), | |
| player_ids = list(), | |
| team_name = character() | |
| ) | |
| empty_selection_choices <- stats::setNames(character(), character()) | |
| get_global_value <- function(name, default = NULL, mode = "any") { | |
| if (exists(name, mode = mode, inherits = TRUE)) { | |
| get(name, mode = mode, inherits = TRUE) | |
| } else { | |
| default | |
| } | |
| } | |
| default_from_choices <- function(choices) { | |
| if (length(choices) == 0) { | |
| character(0) | |
| } else { | |
| unname(choices[[1]]) | |
| } | |
| } | |
| get_wvu_role_bundle <- function(lookup_name, choices_name, default_name) { | |
| choices <- get_global_value(choices_name, empty_selection_choices) | |
| list( | |
| lookup = get_global_value(lookup_name, empty_selection_lookup), | |
| choices = choices, | |
| default = get_global_value(default_name, default_from_choices(choices)) | |
| ) | |
| } | |
| bind_app_cache <- function(renderable, ...) { | |
| tryCatch( | |
| shiny::bindCache(renderable, ..., cache = "app"), | |
| error = function(e) renderable | |
| ) | |
| } | |
| initial_hitter_choices <- get_global_value("wvu_hitter_choices", empty_selection_choices) | |
| initial_pitcher_choices <- get_global_value("wvu_pitcher_choices", empty_selection_choices) | |
| initial_catcher_choices <- get_global_value("wvu_catcher_choices", empty_selection_choices) | |
| initial_hitter_default <- get_global_value("default_hitter_selection", default_from_choices(initial_hitter_choices)) | |
| initial_pitcher_default <- get_global_value("default_pitcher_selection", default_from_choices(initial_pitcher_choices)) | |
| initial_catcher_default <- get_global_value("default_catcher_selection", default_from_choices(initial_catcher_choices)) | |
| player_fixed_datatable <- function(tbl, page_length = 20, filter = "top", rownames = FALSE) { | |
| player_cols <- c("Batter", "Pitcher", "Name", "Player", "Catcher", "Fielder") | |
| player_col <- intersect(player_cols, names(tbl))[1] | |
| left_cols <- if (is.na(player_col)) 1L else match(player_col, names(tbl)) | |
| DT::datatable( | |
| tbl, | |
| extensions = c("FixedHeader", "FixedColumns"), | |
| options = list( | |
| scrollX = TRUE, | |
| scrollY = "70vh", | |
| scrollCollapse = TRUE, | |
| pageLength = page_length, | |
| fixedHeader = list(header = TRUE, headerOffset = 80), | |
| fixedColumns = list(leftColumns = left_cols) | |
| ), | |
| filter = filter, | |
| rownames = rownames | |
| ) | |
| } | |
| defense_error_message <- function(err, fallback = "Defense output failed") { | |
| msg <- conditionMessage(err) | |
| if (is.null(msg) || !nzchar(msg)) { | |
| fallback | |
| } else { | |
| msg | |
| } | |
| } | |
| defense_error_plot <- function(message_text) { | |
| ggplot2::ggplot() + | |
| ggplot2::annotate( | |
| "text", | |
| x = 0.5, | |
| y = 0.5, | |
| label = message_text, | |
| size = 5, | |
| color = "#C94B32", | |
| fontface = "bold" | |
| ) + | |
| ggplot2::xlim(0, 1) + | |
| ggplot2::ylim(0, 1) + | |
| ggplot2::theme_void() | |
| } | |
| defense_error_plotly <- function(message_text) { | |
| plotly::plot_ly( | |
| x = 0.5, | |
| y = 0.5, | |
| type = "scatter", | |
| mode = "text", | |
| text = message_text, | |
| hoverinfo = "skip", | |
| textfont = list(color = "#C94B32", size = 16) | |
| ) %>% | |
| plotly::layout( | |
| xaxis = list(visible = FALSE, range = c(0, 1), fixedrange = TRUE), | |
| yaxis = list(visible = FALSE, range = c(0, 1), fixedrange = TRUE), | |
| margin = list(l = 20, r = 20, t = 20, b = 20), | |
| plot_bgcolor = "white", | |
| paper_bgcolor = "white", | |
| showlegend = FALSE | |
| ) | |
| } | |
| defense_error_table <- function(message_text) { | |
| tibble::tibble(Error = message_text) | |
| } | |
| hitter_summary_cols <- c( | |
| "Batter", "Season", "Date", "Inning", "PitchNo", "PitchCall", "Distance", "Bearing", "event_type", | |
| "ExitSpeed", "Angle", "xba", "xslg", "xwOBA", "woba", "wobacon", | |
| "TaggedPitchType", "PitcherThrows", "is_plate_appearance", "is_walk", "is_k", | |
| "is_hit", "is_barrel", "is_hard_hit", "is_whiff", "chase", "sd_rv_added", "in_zone_whiff", | |
| "on_base", "PlayResult", "AutoHitType", "BatterSide", "KorBB", "ContactPositionX", | |
| "ContactPositionY", "ContactPositionZ", "in_zone", "is_swing", "Balls", "Strikes" | |
| ) | |
| hitter_game_cols <- unique(c( | |
| hitter_summary_cols, | |
| "Pitcher", "RelSpeed", "Date", "GameID", "PitcherTeam", "BatterTeam", "PlateLocSide", "PlateLocHeight", "PitchofPA", "PAofInning", "Inning" | |
| )) | |
| hitter_zone_cols <- c( | |
| "Batter", "PitcherThrows", "TaggedPitchType", "PlateLocSide", "PlateLocHeight", | |
| "PitchCall", "ExitSpeed", "wobacon", "xwOBA", "is_whiff", "is_hard_hit", | |
| "sd_rv_added", "correct_decision", "in_zone", "is_swing", "BatterSide" | |
| ) | |
| hitter_table_cols <- c( | |
| "Batter", "Pitcher", "PitcherThrows", "TaggedPitchType", "Top.Bottom", "BatterSide", | |
| "Date", "PitchCall", "PlayResult", "AutoHitType", "ExitSpeed", "Angle", "Bearing", | |
| "RelSpeed", "InducedVertBreak", "HorzBreak", "SpinRate", "RelHeight", "RelSide", | |
| "VertApprAngle", "Extension", "Balls", "Strikes", "Outs", "Inning", "xba", "xslg", | |
| "xwOBA", "is_plate_appearance", "is_barrel", "is_hard_hit", "is_hit", "on_base", | |
| "slg", "chase", "sd_rv_added", "is_whiff", "in_zone_whiff", "in_zone", "is_swing", | |
| "is_k", "is_walk", "ax0", "az0" | |
| ) | |
| pitcher_summary_cols <- c( | |
| "Pitcher", "Batter", "Season", "Date", "PitchNo", "PitchofPA", "PAofInning", "Inning", "BatterSide", "PitcherThrows", | |
| "TaggedPitchType", "RelSide", "RelHeight", "Extension", "HorzBreak", | |
| "InducedVertBreak", "VertBreak", "SpinRate", "SpinAxis", "VertApprAngle", | |
| "HorzApprAngle", "RelSpeed", "PitchCall", "ExitSpeed", "AutoHitType", "PlayResult", | |
| "is_plate_appearance", "is_hit", "is_walk", "is_k", "is_csw", "is_barrel", "is_hard_hit", "chase", "sd_rv_added", "in_zone", | |
| "is_put_away", "in_zone_whiff", "is_whiff", "xba", "xwOBA", "OutsOnPlay", | |
| "RunsScored", "stuff", "arm_angle", "PlateLocSide", "PlateLocHeight", "BatterTeam", | |
| "Balls", "Strikes" | |
| ) | |
| catcher_cols <- c( | |
| "Season", "Catcher", "CatcherId", "PlateLocSide", "PlateLocHeight", "sz_bot", "sz_top", | |
| "is_swing", "is_csw", "strike_prob", "BasePositionX", "BasePositionY", "BasePositionZ", | |
| "PopTime", "TimeToBase", "ExchangeTime", "ThrowSpeed" | |
| ) | |
| hitter_summary_cols <- unique(c(hitter_summary_cols, "BatterId")) | |
| hitter_game_cols <- unique(c(hitter_game_cols, "BatterId")) | |
| hitter_zone_cols <- unique(c(hitter_zone_cols, "BatterId")) | |
| hitter_table_cols <- unique(c(hitter_table_cols, "BatterId", "PitcherId")) | |
| pitcher_summary_cols <- unique(c(pitcher_summary_cols, "PitcherId")) | |
| active_hitter_bundle <- reactive(get_wvu_role_bundle("wvu_hitter_lookup", "wvu_hitter_choices", "default_hitter_selection")) | |
| active_pitcher_bundle <- reactive(get_wvu_role_bundle("wvu_pitcher_lookup", "wvu_pitcher_choices", "default_pitcher_selection")) | |
| active_catcher_bundle <- reactive(get_wvu_role_bundle("wvu_catcher_lookup", "wvu_catcher_choices", "default_catcher_selection")) | |
| active_hitter_lookup <- reactive(active_hitter_bundle()$lookup) | |
| active_pitcher_lookup <- reactive(active_pitcher_bundle()$lookup) | |
| active_catcher_lookup <- reactive(active_catcher_bundle()$lookup) | |
| active_hitter_choices <- reactive(active_hitter_bundle()$choices) | |
| active_pitcher_choices <- reactive(active_pitcher_bundle()$choices) | |
| active_catcher_choices <- reactive(active_catcher_bundle()$choices) | |
| active_hitter_default <- reactive(active_hitter_bundle()$default) | |
| active_pitcher_default <- reactive(active_pitcher_bundle()$default) | |
| active_catcher_default <- reactive(active_catcher_bundle()$default) | |
| active_outfielder_choices <- reactive(get_global_value("outfielders", character())) | |
| active_infielder_choices <- reactive(get_global_value("infielders", character())) | |
| active_outfielder_default <- reactive(get_global_value("default_outfielder_selection", character(0))) | |
| active_infielder_default <- reactive(get_global_value("default_infielder_selection", character(0))) | |
| active_hitter_pool_ids <- reactive(get_global_value("wvu_hitter_ids", character())) | |
| active_pitcher_pool_ids <- reactive(get_global_value("wvu_pitcher_ids", character())) | |
| active_team_oaa_names <- reactive(get_global_value("wvu_hitters", character())) | |
| valid_selection_id <- function(selection_id, lookup) { | |
| !is.null(selection_id) && nzchar(selection_id) && selection_id %in% lookup$selection_id | |
| } | |
| safe_lookup <- function(active_lookup, fallback_name) { | |
| tryCatch( | |
| active_lookup(), | |
| error = function(e) get_global_value(fallback_name, empty_selection_lookup) | |
| ) | |
| } | |
| safe_default <- function(active_default, choices_name, default_name) { | |
| tryCatch( | |
| active_default(), | |
| error = function(e) get_global_value(default_name, default_from_choices(get_global_value(choices_name, empty_selection_choices))) | |
| ) | |
| } | |
| resolve_choice_selection <- function(current_value, choices, fallback = NULL) { | |
| values <- as.character(unname(choices)) | |
| if (length(values) == 0) { | |
| return(character(0)) | |
| } | |
| if (!is.null(current_value) && length(current_value) == 1 && nzchar(current_value) && current_value %in% values) { | |
| return(current_value) | |
| } | |
| if (!is.null(fallback) && length(fallback) == 1 && nzchar(fallback) && fallback %in% values) { | |
| return(fallback) | |
| } | |
| values[[1]] | |
| } | |
| refresh_scope_inputs <- function(view) { | |
| view <- view %||% "hitters_summary" | |
| if (view %in% c("hitters_summary", "hitters_game", "hitters_zones")) { | |
| hitter_choices <- active_hitter_choices() | |
| for (input_id in intersect( | |
| c("player", "hitter_by_game", "hitter_zone"), | |
| switch( | |
| view, | |
| hitters_summary = "player", | |
| hitters_game = "hitter_by_game", | |
| hitters_zones = "hitter_zone", | |
| c("player", "hitter_by_game", "hitter_zone") | |
| ) | |
| )) { | |
| hitter_selected <- resolve_choice_selection( | |
| input[[input_id]], | |
| hitter_choices, | |
| current_hitter_selection() | |
| ) | |
| updateSelectizeInput(session, input_id, choices = hitter_choices, selected = hitter_selected, server = FALSE) | |
| } | |
| } | |
| if (view %in% c("pitchers_summary", "pitchers_by_date", "new_pitch", "stuffbymovement", "pens", "sims", "pitchers_similarity")) { | |
| pitcher_choices <- active_pitcher_choices() | |
| pitcher_input_ids <- switch( | |
| view, | |
| pitchers_summary = "pitcher", | |
| pitchers_by_date = "Pitcher_dates", | |
| new_pitch = "new_pitch_pitcher", | |
| stuffbymovement = "stuff_pitcher", | |
| pens = "pens_pitcher", | |
| sims = "sim_pitcher", | |
| pitchers_similarity = "similarity_pitcher", | |
| c("pitcher", "Pitcher_dates", "new_pitch_pitcher", "stuff_pitcher", "pens_pitcher", "sim_pitcher", "similarity_pitcher") | |
| ) | |
| for (input_id in pitcher_input_ids) { | |
| pitcher_selected <- resolve_choice_selection( | |
| input[[input_id]], | |
| pitcher_choices, | |
| current_pitcher_selection() | |
| ) | |
| updateSelectizeInput(session, input_id, choices = pitcher_choices, selected = pitcher_selected, server = FALSE) | |
| } | |
| } | |
| if (identical(view, "catching_defense")) { | |
| catcher_choices <- active_catcher_choices() | |
| catcher_selected <- resolve_choice_selection(input$catcher, catcher_choices, active_catcher_default()) | |
| updateSelectizeInput(session, "catcher", choices = catcher_choices, selected = catcher_selected, server = FALSE) | |
| } | |
| if (identical(view, "outfield_defense")) { | |
| outfielder_choices <- active_outfielder_choices() | |
| outfielder_selected <- resolve_choice_selection(input$outfielder, outfielder_choices, active_outfielder_default()) | |
| updateSelectInput(session, "outfielder", choices = outfielder_choices, selected = outfielder_selected) | |
| } | |
| if (identical(view, "infield_defense")) { | |
| infielder_choices <- active_infielder_choices() | |
| infielder_selected <- resolve_choice_selection(input$infielder, infielder_choices, active_infielder_default()) | |
| updateSelectInput(session, "infielder", choices = infielder_choices, selected = infielder_selected) | |
| } | |
| } | |
| observeEvent(input$current_view, { | |
| refresh_scope_inputs(input$current_view) | |
| }, ignoreInit = TRUE) | |
| selected_hitter_name <- function(selection_id) { | |
| lookup_selection_name(selection_id, safe_lookup(active_hitter_lookup, "wvu_hitter_lookup")) | |
| } | |
| selected_hitter_ids <- function(selection_id) { | |
| lookup_selection_ids(selection_id, safe_lookup(active_hitter_lookup, "wvu_hitter_lookup")) | |
| } | |
| selected_pitcher_name <- function(selection_id) { | |
| lookup_selection_name(selection_id, safe_lookup(active_pitcher_lookup, "wvu_pitcher_lookup")) | |
| } | |
| selected_pitcher_ids <- function(selection_id) { | |
| lookup_selection_ids(selection_id, safe_lookup(active_pitcher_lookup, "wvu_pitcher_lookup")) | |
| } | |
| selected_catcher_name <- function(selection_id) { | |
| lookup_selection_name(selection_id, safe_lookup(active_catcher_lookup, "wvu_catcher_lookup")) | |
| } | |
| selected_catcher_ids <- function(selection_id) { | |
| lookup_selection_ids(selection_id, safe_lookup(active_catcher_lookup, "wvu_catcher_lookup")) | |
| } | |
| current_hitter_selection <- function(input_id = NULL) { | |
| if (!is.null(input_id) && isTruthy(input[[input_id]])) { | |
| return(input[[input_id]]) | |
| } | |
| for (candidate in c("player", "hitter_by_game", "hitter_zone")) { | |
| if (valid_selection_id(input[[candidate]], safe_lookup(active_hitter_lookup, "wvu_hitter_lookup"))) { | |
| return(input[[candidate]]) | |
| } | |
| } | |
| safe_default(active_hitter_default, "wvu_hitter_choices", "default_hitter_selection") | |
| } | |
| current_pitcher_selection <- function(input_id = NULL) { | |
| if (!is.null(input_id) && isTruthy(input[[input_id]])) { | |
| return(input[[input_id]]) | |
| } | |
| for (candidate in c("pitcher", "Pitcher_dates", "new_pitch_pitcher", "stuff_pitcher", "pens_pitcher", "sim_pitcher", "similarity_pitcher")) { | |
| if (valid_selection_id(input[[candidate]], safe_lookup(active_pitcher_lookup, "wvu_pitcher_lookup"))) { | |
| return(input[[candidate]]) | |
| } | |
| } | |
| safe_default(active_pitcher_default, "wvu_pitcher_choices", "default_pitcher_selection") | |
| } | |
| current_hitter_name <- function(input_id = NULL) { | |
| selected_hitter_name(current_hitter_selection(input_id)) | |
| } | |
| current_hitter_ids <- function(input_id = NULL) { | |
| selected_hitter_ids(current_hitter_selection(input_id)) | |
| } | |
| current_pitcher_name <- function(input_id = NULL) { | |
| selected_pitcher_name(current_pitcher_selection(input_id)) | |
| } | |
| current_pitcher_ids <- function(input_id = NULL) { | |
| selected_pitcher_ids(current_pitcher_selection(input_id)) | |
| } | |
| exact_pitcher_selection <- function(input_id) { | |
| if (is.null(input_id)) { | |
| return(character(0)) | |
| } | |
| selection_id <- input[[input_id]] | |
| if (valid_selection_id(selection_id, safe_lookup(active_pitcher_lookup, "wvu_pitcher_lookup"))) { | |
| return(selection_id) | |
| } | |
| character(0) | |
| } | |
| exact_pitcher_name <- function(input_id) { | |
| selected_pitcher_name(exact_pitcher_selection(input_id)) | |
| } | |
| exact_pitcher_ids <- function(input_id) { | |
| selected_pitcher_ids(exact_pitcher_selection(input_id)) | |
| } | |
| hitter_summary_data <- reactive({ | |
| req(current_hitter_selection("player"), input$season) | |
| batter_ids <- current_hitter_ids("player") | |
| req(length(batter_ids) > 0) | |
| query_tm_pbp( | |
| columns = hitter_summary_cols, | |
| seasons = input$season, | |
| batter_ids = batter_ids, | |
| cache_prefix = "server_hitter_summary" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| hitter_game_data <- reactive({ | |
| req(current_hitter_selection("hitter_by_game")) | |
| batter_ids <- current_hitter_ids("hitter_by_game") | |
| req(length(batter_ids) > 0) | |
| query_tm_pbp( | |
| columns = hitter_game_cols, | |
| batter_ids = batter_ids, | |
| cache_prefix = "server_hitter_game" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| hitter_zone_data <- reactive({ | |
| req(current_hitter_selection("hitter_zone")) | |
| batter_ids <- current_hitter_ids("hitter_zone") | |
| req(length(batter_ids) > 0) | |
| query_tm_pbp( | |
| columns = hitter_zone_cols, | |
| batter_ids = batter_ids, | |
| pitch_types = if (isTruthy(input$type_zones) && input$type_zones != "All") input$type_zones else NULL, | |
| pitcher_throws = if (isTruthy(input$side_zones) && input$side_zones != "Any") input$side_zones else NULL, | |
| cache_prefix = "server_hitter_zones" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| hitter_leaderboard_data <- reactive({ | |
| req(input$pthrows, input$date_range_hitters) | |
| batter_ids <- active_hitter_pool_ids() | |
| req(length(batter_ids) > 0) | |
| query_tm_pbp( | |
| columns = hitter_table_cols, | |
| batter_ids = batter_ids, | |
| pitcher_throws = if (input$pthrows %in% c("Left", "Right")) input$pthrows else NULL, | |
| date_range = input$date_range_hitters, | |
| cache_prefix = "server_hitter_leaderboard" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| hitter_filter_data <- reactive({ | |
| top_bottom <- NULL | |
| if (identical(input$loc_filter, "Home")) { | |
| top_bottom <- "Bottom" | |
| } else if (identical(input$loc_filter, "Away")) { | |
| top_bottom <- "Top" | |
| } | |
| batter_ids <- active_hitter_pool_ids() | |
| req(length(batter_ids) > 0) | |
| query_tm_pbp( | |
| columns = hitter_table_cols, | |
| batter_ids = batter_ids, | |
| pitcher_throws = if (isTruthy(input$side_filter) && input$side_filter != "Any") input$side_filter else NULL, | |
| pitch_types = if (isTruthy(input$type_filter) && input$type_filter != "Any") input$type_filter else NULL, | |
| top_bottom = top_bottom, | |
| cache_prefix = "server_hitter_filter" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| hitter_arsenal_data <- reactive({ | |
| top_bottom <- NULL | |
| if (identical(input$loc_filter2, "Home")) { | |
| top_bottom <- "Bottom" | |
| } else if (identical(input$loc_filter2, "Away")) { | |
| top_bottom <- "Top" | |
| } | |
| batter_ids <- active_hitter_pool_ids() | |
| req(length(batter_ids) > 0) | |
| query_tm_pbp( | |
| columns = hitter_table_cols, | |
| batter_ids = batter_ids, | |
| pitcher_throws = if (isTruthy(input$side_filter2) && input$side_filter2 != "Any") input$side_filter2 else NULL, | |
| pitch_types = if (isTruthy(input$type_filter2) && input$type_filter2 != "Any") input$type_filter2 else NULL, | |
| top_bottom = top_bottom, | |
| cache_prefix = "server_hitter_arsenal" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| pitcher_summary_data <- reactive({ | |
| req(current_pitcher_selection("pitcher"), input$season_pitchers) | |
| pitcher_ids <- current_pitcher_ids("pitcher") | |
| req(length(pitcher_ids) > 0) | |
| query_tm_pbp( | |
| columns = pitcher_summary_cols, | |
| seasons = input$season_pitchers, | |
| pitcher_ids = pitcher_ids, | |
| cache_prefix = "server_pitcher_summary" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| pitcher_by_date_data <- reactive({ | |
| req(isTruthy(exact_pitcher_selection("Pitcher_dates"))) | |
| pitcher_ids <- exact_pitcher_ids("Pitcher_dates") | |
| req(length(pitcher_ids) > 0) | |
| query_tm_pbp( | |
| columns = unique(c(pitcher_summary_cols, "GameID")), | |
| pitcher_ids = pitcher_ids, | |
| cache_prefix = "server_pitcher_by_date" | |
| ) | |
| }) | |
| pitcher_leaderboard_data <- reactive({ | |
| req(input$date_range_pitchers) | |
| pitcher_ids <- active_pitcher_pool_ids() | |
| req(length(pitcher_ids) > 0) | |
| query_tm_pbp( | |
| columns = pitcher_summary_cols, | |
| pitcher_ids = pitcher_ids, | |
| batter_sides = if (input$side %in% c("Left", "Right")) input$side else NULL, | |
| date_range = input$date_range_pitchers, | |
| cache_prefix = "server_pitcher_leaderboard" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| stuff_movement_data <- reactive({ | |
| req(current_pitcher_selection("stuff_pitcher")) | |
| pitcher_ids <- current_pitcher_ids("stuff_pitcher") | |
| req(length(pitcher_ids) > 0) | |
| query_tm_pbp( | |
| columns = pitcher_summary_cols, | |
| pitcher_ids = pitcher_ids, | |
| cache_prefix = "server_stuff_movement" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| catcher_view_data <- reactive({ | |
| req(input$season_catchers, input$catcher) | |
| catcher_ids <- selected_catcher_ids(input$catcher) | |
| req(length(catcher_ids) > 0) | |
| query_tm_pbp( | |
| columns = catcher_cols, | |
| seasons = input$season_catchers, | |
| catcher_ids = catcher_ids, | |
| cache_prefix = "server_catcher_view" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| similarity_pitcher_data <- reactive({ | |
| req(current_pitcher_selection("similarity_pitcher"), input$similarity_pitch_type) | |
| pitcher_ids <- current_pitcher_ids("similarity_pitcher") | |
| req(length(pitcher_ids) > 0) | |
| query_tm_pbp( | |
| columns = c("Pitcher", "PitcherId", "TaggedPitchType", "Season", "RelSpeed", "HorzBreak", "InducedVertBreak", "arm_angle"), | |
| pitcher_ids = pitcher_ids, | |
| pitch_types = input$similarity_pitch_type, | |
| seasons = if (isTruthy(input$similarity_season) && input$similarity_season != "All") input$similarity_season else NULL, | |
| cache_prefix = "server_similarity_pitcher" | |
| ) %>% | |
| filter_out_scrimmage_dates() | |
| }) | |
| hitter_summary_context <- reactive({ | |
| req(current_hitter_selection("player"), input$season) | |
| data <- hitter_summary_data() | |
| if (is_spring_season_label(input$season)) { | |
| data <- data[!is_wvu_vs_wvu_game(data), , drop = FALSE] | |
| } | |
| list( | |
| data = data, | |
| selection = current_hitter_selection("player"), | |
| ids = current_hitter_ids("player"), | |
| name = current_hitter_name("player"), | |
| season = input$season | |
| ) | |
| }) | |
| get_hitter_summary_bundle_cached <- function(selection, season, ids, name, data, scope = "wvu") { | |
| ids <- as.character(ids) | |
| ids <- ids[!is.na(ids) & nzchar(ids)] | |
| cache_key <- make_cache_key( | |
| "server_hitter_summary_bundle", | |
| scope, | |
| selection %||% "", | |
| season %||% "", | |
| cache_key_part(ids) | |
| ) | |
| cache_get_or_set(cache_key, { | |
| radial_plot <- radial(data, name) | |
| spider_plot <- get_spider(hitter_stats, name, season, batter_ids = ids) | |
| list( | |
| val_percentiles = value_percentiles(hit_war, name, season, batter_ids = ids), | |
| hit_percentiles = hitter_percentiles(data, name, season, batter_ids = ids), | |
| field_percentiles = fielding_percentiles(defense, name, season, batter_ids = ids), | |
| spray_chart = spray_chart(data, name), | |
| rolling_xwoba = rolling_xwOBA(data, name), | |
| radial = radial_plot, | |
| hit_summary_overall = hitter_summary_overall(data, name, season, hitter_stats, batter_ids = ids), | |
| hit_summary = hitter_summary(data, name), | |
| bb_profile = batted_ball_profile(data, name), | |
| discipline = plate_discipline(data, name), | |
| row_1_hitter = gridExtra::arrangeGrob(spider_plot, radial_plot, ncol = 2), | |
| contact = contact_pos(data, name, season) | |
| ) | |
| }, namespace = "server_hitter_summary_bundle") | |
| } | |
| hitter_summary_bundle <- reactive({ | |
| ctx <- hitter_summary_context() | |
| get_hitter_summary_bundle_cached( | |
| selection = ctx$selection, | |
| season = ctx$season, | |
| ids = ctx$ids, | |
| name = ctx$name, | |
| data = ctx$data, | |
| scope = player_scope() | |
| ) | |
| }) | |
| prewarm_hitter_summary_bundle_cache <- local({ | |
| warmed <- FALSE | |
| function(force = FALSE) { | |
| if (warmed && !force) { | |
| return(invisible(NULL)) | |
| } | |
| if (tolower(Sys.getenv("WVU_APP_PREWARM_HITTER_RENDER_CACHE", "false")) != "true") { | |
| warmed <<- TRUE | |
| return(invisible(NULL)) | |
| } | |
| seasons <- get_available_seasons() | |
| lookup <- get_global_value("wvu_hitter_lookup", empty_selection_lookup) | |
| if (nrow(lookup) == 0 || length(seasons) == 0) { | |
| warmed <<- TRUE | |
| return(invisible(NULL)) | |
| } | |
| for (row_index in seq_len(nrow(lookup))) { | |
| selection_id <- lookup$selection_id[[row_index]] | |
| player_name <- lookup$player_name[[row_index]] | |
| player_ids <- as.character(lookup$player_ids[[row_index]]) | |
| player_ids <- player_ids[!is.na(player_ids) & nzchar(player_ids)] | |
| if (!nzchar(selection_id) || !nzchar(player_name) || length(player_ids) == 0) { | |
| next | |
| } | |
| for (season_value in seasons) { | |
| summary_data <- query_tm_pbp( | |
| columns = hitter_summary_cols, | |
| seasons = season_value, | |
| batter_ids = player_ids, | |
| cache_prefix = "server_hitter_summary" | |
| ) | |
| invisible(get_hitter_summary_bundle_cached( | |
| selection = selection_id, | |
| season = season_value, | |
| ids = player_ids, | |
| name = player_name, | |
| data = summary_data, | |
| scope = "wvu" | |
| )) | |
| } | |
| } | |
| warmed <<- TRUE | |
| invisible(NULL) | |
| } | |
| }) | |
| prewarm_hitter_summary_bundle_cache() | |
| prewarm_initial_hitter_summary_bundle <- function() { | |
| default_selection <- initial_hitter_default | |
| if (is.null(default_selection) || !nzchar(default_selection)) { | |
| return(invisible(NULL)) | |
| } | |
| season_value <- get_default_season() | |
| player_ids <- selected_hitter_ids(default_selection) | |
| player_ids <- as.character(player_ids) | |
| player_ids <- player_ids[!is.na(player_ids) & nzchar(player_ids)] | |
| player_name <- selected_hitter_name(default_selection) | |
| if (!nzchar(player_name) || length(player_ids) == 0 || is.null(season_value) || !nzchar(season_value)) { | |
| return(invisible(NULL)) | |
| } | |
| summary_data <- query_tm_pbp( | |
| columns = hitter_summary_cols, | |
| seasons = season_value, | |
| batter_ids = player_ids, | |
| cache_prefix = "server_hitter_summary" | |
| ) | |
| invisible(get_hitter_summary_bundle_cached( | |
| selection = default_selection, | |
| season = season_value, | |
| ids = player_ids, | |
| name = player_name, | |
| data = summary_data, | |
| scope = "wvu" | |
| )) | |
| } | |
| session$onFlushed(function() { | |
| prewarm_initial_hitter_summary_bundle() | |
| }, once = TRUE) | |
| pitcher_summary_context <- reactive({ | |
| req(current_pitcher_selection("pitcher"), input$season_pitchers) | |
| data <- pitcher_summary_data() | |
| if (is_spring_season_label(input$season_pitchers)) { | |
| data <- data[!is_wvu_vs_wvu_game(data), , drop = FALSE] | |
| } | |
| list( | |
| data = data, | |
| selection = current_pitcher_selection("pitcher"), | |
| ids = current_pitcher_ids("pitcher"), | |
| name = current_pitcher_name("pitcher"), | |
| season = input$season_pitchers | |
| ) | |
| }) | |
| hitter_game_choices <- reactive({ | |
| req(current_hitter_selection("hitter_by_game")) | |
| build_hitter_game_choices(hitter_game_data(), current_hitter_ids("hitter_by_game")) | |
| }) | |
| pitcher_by_date_game_choices <- reactive({ | |
| req(isTruthy(exact_pitcher_selection("Pitcher_dates"))) | |
| build_pitcher_game_choices( | |
| pitcher_by_date_data(), | |
| pitcher_ids = exact_pitcher_ids("Pitcher_dates") | |
| ) | |
| }) | |
| pitcher_by_date_selected_data <- reactive({ | |
| req(isTruthy(exact_pitcher_selection("Pitcher_dates")), input$Pitcher_game_dates) | |
| filter_pitcher_game_data( | |
| pitcher_by_date_data(), | |
| input$Pitcher_game_dates, | |
| pitcher_ids = exact_pitcher_ids("Pitcher_dates") | |
| ) | |
| }) | |
| bullpen_selected_data <- reactive({ | |
| req(current_pitcher_selection("pens_pitcher"), input$pens_dates) | |
| selected_ids <- current_pitcher_ids("pens_pitcher") | |
| bullpens %>% | |
| filter( | |
| as.character(PitcherId) %in% selected_ids, | |
| Date == input$pens_dates | |
| ) | |
| }) | |
| sim_selected_data <- reactive({ | |
| req(current_pitcher_selection("sim_pitcher"), input$sim_pitcher_dates) | |
| selected_ids <- current_pitcher_ids("sim_pitcher") | |
| sim_games %>% | |
| mutate(label = as.character(Date)) %>% | |
| filter( | |
| as.character(PitcherId) %in% selected_ids, | |
| label %in% input$sim_pitcher_dates | |
| ) | |
| }) | |
| outfield_oaa_all <- reactive({ | |
| query_outfield_oaa() | |
| }) | |
| outfield_oaa_season <- reactive({ | |
| req(input$season_outfield) | |
| query_outfield_oaa(input$season_outfield) | |
| }) | |
| infield_oaa_all <- reactive({ | |
| query_infield_oaa() | |
| }) | |
| infield_oaa_season <- reactive({ | |
| req(input$season_infield) | |
| query_infield_oaa(input$season_infield) | |
| }) | |
| output$login_ui <- renderUI({ | |
| if (!user_auth() || login_transition()) { | |
| div( | |
| class = paste("login-container", if (login_transition()) "login-container-exit"), | |
| tags$style(HTML(" | |
| @keyframes fadeInUp { | |
| from { opacity: 0; transform: translateY(30px); } | |
| to { opacity: 1; transform: translateY(0); } | |
| } | |
| @keyframes shimmer { | |
| 0% { background-position: -200% 0; } | |
| 100% { background-position: 200% 0; } | |
| } | |
| /* Logo expands smoothly in one motion while moving to center */ | |
| @keyframes logoExpand { | |
| from { | |
| transform: translate(0, 0) scale(3); | |
| opacity: 1; | |
| } | |
| to { | |
| transform: translate(var(--move-x), var(--move-y)) scale(50); | |
| opacity: 0; | |
| } | |
| } | |
| /* Login fades out as logo expands */ | |
| @keyframes loginFadeOut { | |
| from { opacity: 1; } | |
| to { opacity: 0; } | |
| } | |
| .login-container { | |
| position: fixed; | |
| inset: 0; | |
| display: flex; | |
| background: var(--white); | |
| overflow: hidden; | |
| } | |
| .login-hero { | |
| flex: 1; | |
| position: relative; | |
| overflow: hidden; | |
| display: none; | |
| } | |
| @media (min-width: 900px) { | |
| .login-hero { display: block; } | |
| } | |
| .login-hero-bg { | |
| position: absolute; | |
| inset: 0; | |
| background-image: url('https://images.sidearmdev.com/crop?url=https%3a%2f%2fdxbhsrqyrr690.cloudfront.net%2fsidearm.nextgen.sites%2fwvuni.sidearmsports.com%2fimages%2f2025%2f2%2f18%2fWVU02765_large.jpg&height=1200&width=1600&type=webp'); | |
| background-size: cover; | |
| background-position: center; | |
| transform: scale(1.5); | |
| transition: transform 8s ease-out; | |
| } | |
| .login-container:hover .login-hero-bg { | |
| transform: scale(1); | |
| } | |
| .login-hero::after { | |
| content: ''; | |
| position: absolute; | |
| inset: 0; | |
| background: linear-gradient( | |
| 135deg, | |
| rgba(0, 40, 85, 0.85) 0%, | |
| rgba(0, 26, 58, 0.92) 100% | |
| ); | |
| } | |
| .login-form-panel { | |
| flex: 0 0 520px; | |
| display: flex; | |
| flex-direction: column; | |
| justify-content: center; | |
| padding: 60px; | |
| background: white; | |
| position: relative; | |
| overflow: hidden; | |
| } | |
| @media (max-width: 899px) { | |
| .login-form-panel { | |
| flex: 1; | |
| background-image: linear-gradient( | |
| rgba(255, 255, 255, 0.95), | |
| rgba(255, 255, 255, 0.95) | |
| ), url('https://images.sidearmdev.com/crop?url=https%3a%2f%2fdxbhsrqyrr690.cloudfront.net%2fsidearm.nextgen.sites%2fwvuni.sidearmsports.com%2fimages%2f2025%2f2%2f18%2fWVU02765_large.jpg&height=563&width=1000&type=webp'); | |
| background-size: cover; | |
| background-position: center; | |
| } | |
| } | |
| .login-form-panel::before { | |
| content: ''; | |
| position: absolute; | |
| top: -50%; | |
| right: -50%; | |
| width: 100%; | |
| height: 100%; | |
| background: radial-gradient(circle, rgba(0, 40, 85, 0.03) 0%, transparent 70%); | |
| pointer-events: none; | |
| } | |
| .login-form-inner { | |
| max-width: 360px; | |
| margin: 0 auto; | |
| width: 100%; | |
| display: flex; | |
| flex-direction: column; | |
| align-items: center; | |
| position: relative; | |
| z-index: 1; | |
| } | |
| .login-branding { | |
| display: flex; | |
| align-items: center; | |
| justify-content: center; | |
| gap: 20px; | |
| margin-bottom: 40px; | |
| animation: fadeInUp 0.6s ease-out; | |
| width: 100%; | |
| } | |
| .login-logo-img { | |
| height: 70px; | |
| width: auto; | |
| filter: drop-shadow(0 4px 12px rgba(0, 40, 85, 0.15)); | |
| } | |
| .login-branding-text { | |
| border-left: 3px solid #EAAA00; | |
| padding-left: 20px; | |
| } | |
| .login-branding-text h1 { | |
| font-size: 22px; | |
| font-weight: 700; | |
| color: #002855; | |
| margin: 0; | |
| line-height: 1.2; | |
| } | |
| .login-form-group { | |
| margin-bottom: 24px; | |
| animation: fadeInUp 0.6s ease-out 0.2s both; | |
| width: 100%; | |
| } | |
| .login-form-group .control-label { | |
| display: none !important; | |
| } | |
| .login-form-group .shiny-input-container, | |
| .login-form-group > div { | |
| width: 100% !important; | |
| } | |
| .login-form-group .form-control { | |
| width: 100%; | |
| padding: 16px 18px !important; | |
| border: 2px solid #e2e8f0 !important; | |
| border-radius: 12px !important; | |
| font-size: 16px !important; | |
| font-family: inherit !important; | |
| background: #f8fafc !important; | |
| transition: all 0.2s ease !important; | |
| height: 56px !important; | |
| } | |
| .login-form-group .form-control:focus { | |
| border-color: #002855 !important; | |
| background: white !important; | |
| box-shadow: 0 0 0 4px rgba(0, 40, 85, 0.1) !important; | |
| outline: none !important; | |
| } | |
| .login-btn-wrapper { | |
| animation: fadeInUp 0.6s ease-out 0.3s both; | |
| width: 100%; | |
| } | |
| .login-submit-btn { | |
| width: 100%; | |
| padding: 18px 24px !important; | |
| background: linear-gradient(135deg, #002855 0%, #003875 100%) !important; | |
| border: none !important; | |
| border-radius: 12px !important; | |
| color: white !important; | |
| font-family: inherit !important; | |
| font-size: 16px !important; | |
| font-weight: 600 !important; | |
| cursor: pointer !important; | |
| position: relative; | |
| overflow: hidden; | |
| transition: all 0.3s ease !important; | |
| height: 56px !important; | |
| } | |
| .login-submit-btn::before { | |
| content: ''; | |
| position: absolute; | |
| inset: 0; | |
| background: linear-gradient( | |
| 90deg, | |
| transparent, | |
| rgba(255,255,255,0.2), | |
| transparent | |
| ); | |
| background-size: 200% 100%; | |
| opacity: 0; | |
| transition: opacity 0.3s ease; | |
| } | |
| .login-submit-btn:hover { | |
| background: #EAAA00 !important; | |
| color: #002855 !important; | |
| transform: translateY(-2px) !important; | |
| box-shadow: 0 10px 30px rgba(234, 170, 0, 0.4) !important; | |
| } | |
| .login-submit-btn:hover::before { | |
| opacity: 1; | |
| animation: shimmer 1.5s infinite; | |
| } | |
| .login-submit-btn:active { | |
| transform: translateY(0) !important; | |
| } | |
| /* Expanding logo layer */ | |
| .logo-expand-layer { | |
| position: fixed; | |
| inset: 0; | |
| pointer-events: none; | |
| z-index: 4000; | |
| display: none; | |
| } | |
| .logo-expand-layer img { | |
| position: absolute; | |
| transform-origin: center center; | |
| will-change: transform, opacity; | |
| } | |
| .login-container-exit { | |
| pointer-events: none; | |
| } | |
| .login-container-exit .login-hero, | |
| .login-container-exit .login-form-panel { | |
| animation: loginFadeOut .7s ease-out forwards; | |
| } | |
| .login-container-exit .logo-expand-layer { | |
| display: block; | |
| } | |
| .login-container-exit .logo-expand-layer img { | |
| animation: logoExpand 1s ease-in-out forwards; | |
| } | |
| ")), | |
| # Left side - Hero image with overlay | |
| div( | |
| class = "login-hero", | |
| div(class = "login-hero-bg") | |
| ), | |
| # Right side - Login form | |
| div( | |
| class = "login-form-panel", | |
| div( | |
| class = "login-form-inner", | |
| # Branding | |
| div( | |
| class = "login-branding", | |
| tags$img( | |
| class = "login-logo-img", | |
| src = "https://upload.wikimedia.org/wikipedia/commons/5/5d/WVU_flying_WV_Gold124.svg" | |
| ), | |
| div( | |
| class = "login-branding-text", | |
| tags$h1("WVU Baseball") | |
| ) | |
| ), | |
| # Password input | |
| div( | |
| class = "login-form-group", | |
| passwordInput("password", label = NULL, placeholder = "Enter password") | |
| ), | |
| # Submit button | |
| div( | |
| class = "login-btn-wrapper", | |
| actionButton( | |
| "login_btn", | |
| "Sign In", | |
| class = "login-submit-btn" | |
| ) | |
| ), | |
| ) | |
| ), | |
| div(class = "logo-expand-layer"), | |
| # Enter key handler | |
| tags$script(HTML(" | |
| $(document).on('keypress', function(e) { | |
| if (e.which == 13) { $('#login_btn').click(); } | |
| }); | |
| ")), | |
| if (login_transition()) { | |
| tags$script(HTML(" | |
| (function() { | |
| var logo = document.querySelector('.login-branding .login-logo-img'); | |
| var expandLayer = document.querySelector('.logo-expand-layer'); | |
| if (logo && expandLayer) { | |
| var rect = logo.getBoundingClientRect(); | |
| var clone = logo.cloneNode(true); | |
| // Position clone at logo's current location | |
| clone.style.left = rect.left + 'px'; | |
| clone.style.top = rect.top + 'px'; | |
| clone.style.width = rect.width + 'px'; | |
| clone.style.height = rect.height + 'px'; | |
| // Calculate movement to center | |
| var logoCenterX = rect.left + rect.width / 2; | |
| var logoCenterY = rect.top + rect.height / 2; | |
| var screenCenterX = window.innerWidth / 2; | |
| var screenCenterY = window.innerHeight / 2; | |
| var moveX = screenCenterX - logoCenterX; | |
| var moveY = screenCenterY - logoCenterY; | |
| clone.style.setProperty('--move-x', moveX + 'px'); | |
| clone.style.setProperty('--move-y', moveY + 'px'); | |
| expandLayer.appendChild(clone); | |
| logo.style.visibility = 'hidden'; | |
| } | |
| setTimeout(function() { | |
| Shiny.setInputValue('login_exit_done', Date.now(), {priority: 'event'}); | |
| }, 600); | |
| })(); | |
| ")) | |
| } else { | |
| NULL | |
| } | |
| ) | |
| } else { | |
| NULL | |
| } | |
| }) | |
| observeEvent(input$login_btn, { | |
| if (input$password == PASSWORD) { | |
| login_success_pending(TRUE) | |
| login_transition(TRUE) | |
| } else { | |
| showModal(modalDialog("Incorrect password", easyClose = TRUE)) | |
| } | |
| }) | |
| observeEvent(input$login_exit_done, { | |
| req(login_success_pending()) | |
| user_auth(TRUE) | |
| login_success_pending(FALSE) | |
| login_transition(FALSE) | |
| }) | |
| output$app_ui <- renderUI({ | |
| if (user_auth()) { | |
| div( | |
| class = "app-slide-in", | |
| tags$style(HTML(" | |
| @keyframes appReveal { | |
| from { opacity: 0; } | |
| to { opacity: 1; } | |
| } | |
| .app-slide-in { | |
| animation: appReveal 0.5s ease-out forwards; | |
| } | |
| .selectize-input { background: rgba(255,255,255,0.9)!important; border:1px solid #ccc!important; color:#002855!important; } | |
| .selectize-dropdown { background:#fff!important; border:1px solid #ccc!important; } | |
| .selectize-dropdown .option { | |
| background: #fff !important; | |
| color: #002855 !important; | |
| } | |
| .selectize-dropdown .option:hover, | |
| .selectize-dropdown .option.active { | |
| background: #002855 !important; | |
| color: #ffffff !important; | |
| } | |
| .selectize-dropdown .option:hover { | |
| background: #EAAA00 !important; | |
| color: #002855 !important; | |
| } | |
| .selectize-dropdown .option.selected { | |
| background: #002855 !important; | |
| color: #ffffff !important; | |
| } | |
| .nav-dropdown button:hover { background: rgba(255,255,255,0.1)!important; } | |
| .nav-dropdown div button { | |
| background: white !important; | |
| color: #002855 !important; | |
| } | |
| .nav-dropdown div button:hover { | |
| background: #EAAA00 !important; | |
| color: #002855 !important; | |
| } | |
| #selection_options .selectize-control, | |
| #selection_options .form-group { | |
| margin:0!important; padding:0!important; min-width:50px; max-width:250px; | |
| } | |
| .nav-dropdown > button { text-align:left!important; } | |
| #selection_options .form-group .control-label { | |
| text-align:center!important; display:block; width:100%; | |
| color: #EAAA00 !important; | |
| } | |
| .topbar-logo-wrap { | |
| display: inline-flex; | |
| align-items: center; | |
| justify-content: center; | |
| margin-left: 12px; | |
| padding: 0 6px; | |
| line-height: 1; | |
| } | |
| .topbar-logo-img { | |
| height: 38px; | |
| width: auto; | |
| display: block; | |
| } | |
| /* kill Bootstrap gutters so full-width works */ | |
| html, body { margin:0; padding:0; } | |
| .container-fluid { padding-left:0!important; padding-right:0!important; } | |
| ")), | |
| div( | |
| id = "selection_shell", | |
| style = "background: #002855; padding: 10px 20px; display: flex; justify-content: space-between; align-items: center; box-shadow: 0 2px 4px rgba(0,0,0,0.1); position: sticky; top: 0; z-index: 1100;", | |
| div( | |
| style = "background: #002855; | |
| padding: 0px 0px; | |
| display: flex; | |
| justify-content: flex-start; | |
| align-items: center; | |
| gap: 8px; /* adjust spacing between tabs */ | |
| box-shadow: 0 2px 4px rgba(0,0,0,0.1); | |
| ", | |
| div( | |
| class = "nav-dropdown", | |
| style = "position: relative;", | |
| actionButton("hitters_main", "Hitting", | |
| style = "background: transparent; color: white; border: none; font-size: 16px; padding: 10px 15px; cursor: pointer;"), | |
| div( | |
| id = "hitters_submenu", | |
| style = "position: absolute; top: 100%; left: 0; background: white; min-width: 150px; box-shadow: 0 4px 8px rgba(0,0,0,0.2); border-radius: 5px; display: none; z-index: 1000;", | |
| actionButton("hitters_summary", "Summary", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("hitters_game", "By Game", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("hitters_zones", "Zones", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("hitters_leaderboards", "Leaderboards", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("hitters_pitch_level_filters", "Pitch Level Filters", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("hitters_pitcher_level_filters", "Pitcher Level Filters", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| tags$script(" | |
| $('#hitters_summary, #hitters_game, #hitters_zones, #hitters_leaderboards, #hitters_pitch_level_filters, #hitters_pitcher_level_filters').hover(function() { | |
| $(this).css('background-color', '#EAAA00'); | |
| }, function() { | |
| $(this).css('background-color', 'white'); | |
| }); | |
| ") | |
| ) | |
| ), | |
| div( | |
| class = "nav-dropdown", | |
| style = "position: relative;", | |
| actionButton("pitchers_main", "Pitching", | |
| style = "background: transparent; color: white; border: none; font-size: 16px; padding: 10px 15px; cursor: pointer;"), | |
| div( | |
| id = "pitchers_submenu", | |
| style = "position: absolute; top: 100%; left: 0; background: white; min-width: 150px; box-shadow: 0 4px 8px rgba(0,0,0,0.2); border-radius: 5px; display: none; z-index: 1000;", | |
| actionButton("pitchers_summary", "Summary", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("pitchers_by_date", "By Date", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("new_pitch", "Pitch Addition", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("stuffbymovement", "Ideal Movement", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("pitchers_leaders", "Leaderboards", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("pens", "Bullpens", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("sims", "Sim Games", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("pitchers_similarity", "Similarity", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| tags$script(" | |
| $('#pitchers_summary, #pitchers_by_date, #new_pitch, #stuffbymovement, #pitchers_leaders, #pens, #sims, #pitchers_similarity').hover(function() { | |
| $(this).css('background-color', '#EAAA00'); | |
| }, function() { | |
| $(this).css('background-color', 'white'); | |
| }); | |
| ") | |
| ) | |
| ), | |
| div( | |
| class = "nav-dropdown", | |
| style = "position: relative;", | |
| actionButton("fielding_main", "Fielding", | |
| style = "background: transparent; color: white; border: none; font-size: 16px; padding: 10px 15px; cursor: pointer;"), | |
| div( | |
| id = "fielding_submenu", | |
| style = "position: absolute; top: 100%; left: 0; background: white; min-width: 150px; box-shadow: 0 4px 8px rgba(0,0,0,0.2); border-radius: 5px; display: none; z-index: 1000;", | |
| actionButton("catching_defense", "Catching", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("infield_defense", "Infield", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("outfield_defense", "Outfield", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("team_oaa", "Team OAA", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| tags$script(" | |
| $('#catching_defense, #infield_defense, #outfield_defense, #team_oaa').hover(function() { | |
| $(this).css('background-color', '#EAAA00'); | |
| }, function() { | |
| $(this).css('background-color', 'white'); | |
| }); | |
| ") | |
| ) | |
| ), | |
| div( | |
| class = "nav-dropdown", | |
| style = "position: relative;", | |
| actionButton("glossary", "Glossary", | |
| style = "background: transparent; color: white; border: none; font-size: 16px; padding: 10px 15px; cursor: pointer;") | |
| ), | |
| div( | |
| class = "nav-dropdown", | |
| style = "position: relative;", | |
| actionButton("scores_main", "Scores", | |
| style = "background: transparent; color: white; border: none; font-size: 16px; padding: 10px 15px; cursor: pointer;"), | |
| div( | |
| id = "scores_submenu", | |
| style = "position: absolute; top: 100%; left: 0; background: white; min-width: 150px; box-shadow: 0 4px 8px rgba(0,0,0,0.2); border-radius: 5px; display: none; z-index: 1000;", | |
| actionButton("scores_games", "Games", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| actionButton("scores_standings", "Standings", | |
| style = "display: block; width: 100%; text-align: left; background: white; border: none; padding: 10px 15px; color: #002855; cursor: pointer;"), | |
| tags$script(" | |
| $('#scores_games, #scores_standings').hover(function() { | |
| $(this).css('background-color', '#EAAA00'); | |
| }, function() { | |
| $(this).css('background-color', 'white'); | |
| }); | |
| ") | |
| ) | |
| ), | |
| div( | |
| class = "topbar-logo-wrap", | |
| tags$img( | |
| class = "topbar-logo-img", | |
| src = "https://upload.wikimedia.org/wikipedia/commons/5/5d/WVU_flying_WV_Gold124.svg", | |
| alt = "WVU logo" | |
| ) | |
| ) | |
| ), | |
| div( | |
| id = "selection_options", | |
| style = " | |
| display: flex; | |
| align-items: center; | |
| flex-wrap: nowrap; | |
| gap: 0; | |
| margin: 0; | |
| padding: 0; | |
| ", | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_summary'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("player", "Batter", | |
| choices = initial_hitter_choices, | |
| selected = initial_hitter_default, | |
| multiple = FALSE, | |
| width = "150px"), | |
| selectizeInput("season", "Season", | |
| choices = get_available_seasons(), | |
| selected = get_default_season(), | |
| multiple = FALSE, | |
| width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_game'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("hitter_by_game", "Batter", | |
| choices = initial_hitter_choices, | |
| selected = initial_hitter_default, | |
| width = "150px"), | |
| selectInput("hitter_game_dates", "Game Date", | |
| choices = NULL, | |
| selected = NULL, | |
| multiple = TRUE, | |
| selectize = TRUE) | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_zones'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("hitter_zone", "Batter", | |
| choices = initial_hitter_choices, | |
| selected = initial_hitter_default, | |
| width = "150px"), | |
| selectInput("stat_zones", "Stat", | |
| choices = c("Avg EV", "wOBAcon", "xwOBAcon", "Contact %", "Hard Hit %", | |
| "Swing Decision Runs Gained / 100"), selected = "xwOBAcon", width = "200px"), | |
| selectInput("type_zones", "Pitch Type", choices = c("All", get_pitch_type_choices()), selected = "All", width = "150px"), | |
| selectInput("side_zones", "Pitcher Side", choices = c("Any", "Right", "Left"), selected = "Any", width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_leaderboards'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| dateRangeInput("date_range_hitters", | |
| "Date Range", | |
| start = get_default_start_date(), | |
| end = Sys.Date(), | |
| format = "yyyy-mm-dd", | |
| width = "300px"), | |
| selectInput("table_type", "Select Table Type", | |
| choices = c("Hitter Stats", "Hitter Stats by Pitch Group"), | |
| selected = "Hitter Stats", width = "150px"), | |
| selectInput("pthrows", "By Pitcher Hand", | |
| choices = c("Any", "Right", "Left"), | |
| selected = "Any", width = "100px" | |
| ), | |
| numericInput("sample_pa", | |
| "Min PA", | |
| value = get_leaderboard_default("hitter_pa"), | |
| min = 1, | |
| max = 400, | |
| step = 1, | |
| width = "50px" | |
| ), | |
| numericInput("bbe_hit", | |
| "Min BBE", | |
| value = get_leaderboard_default("hitter_bbe"), | |
| min = 0, | |
| max = 100, | |
| step = 1, | |
| width = "50px" | |
| ) | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_pitch_level_filters'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectInput("side_filter", "Pitch Hand", choices = c("Any", "Right", "Left"), selected = "Any", width = "100px"), | |
| selectInput("type_filter", "Pitch Type", choices = c("Any", get_pitch_type_choices()), selected = "Any", width = "100px"), | |
| selectInput("loc_filter", "H/A", choices = c("Any", "Home", "Away"), selected = "Any", width = "100px"), | |
| selectInput("hitter_location", "Pitch Loc", choices = c("Any", "Inside", "Outside", "Up", "Down"), selected = "Any", width = "100px"), | |
| selectInput("filter_col1", "Stat", choices = c("Balls", "Strikes", "Outs", "Inning", "Velocity", "IVB", "HB", "Spin","RelHeight", "RelSide", "VAA"), selected = "Balls", width = "100px"), | |
| selectInput("filter_op1", "Operator", choices = c("==", "!=", "<", ">", "<=", ">="), width = "100px"), | |
| numericInput("filter_val1", "Value", value = NA, width = "100px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_pitcher_level_filters'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectInput("side_filter2", "Pitch Hand", choices = c("Any", "Right", "Left"), selected = "Any", width = "100px"), | |
| selectInput("type_filter2", "Pitch Type", choices = c("Any", get_pitch_type_choices()), selected = "Any", width = "100px"), | |
| selectInput("loc_filter2", "H/A", choices = c("Any", "Home", "Away"), selected = "Any", width = "100px"), | |
| selectInput("hitter_location2", "Pitch Loc", choices = c("Any", "Inside", "Outside", "Up", "Down"), selected = "Any", width = "100px"), | |
| selectInput("filter_col2", "Stat", choices = c("Balls", "Strikes", "Outs", "Inning", "Velocity", "IVB", "HB", "Spin","RelHeight", "RelSide", "VAA"), selected = "Velocity", width = "100px"), | |
| selectInput("filter_op2", "Operator", choices = c("==", "!=", "<", ">", "<=", ">="), selected = ">=", width = "100px"), | |
| numericInput("filter_val2", "Value", value = NA, width = "100px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_summary'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("pitcher", "Pitcher", | |
| choices = initial_pitcher_choices, | |
| selected = initial_pitcher_default, | |
| width = "150px"), | |
| selectizeInput("season_pitchers", "Season", | |
| choices = get_available_seasons(), | |
| selected = get_default_season(), | |
| multiple = FALSE, | |
| width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_by_date'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("Pitcher_dates", "Pitcher", | |
| choices = initial_pitcher_choices, | |
| selected = initial_pitcher_default, | |
| width = "150px"), | |
| selectizeInput("Pitcher_game_dates", "Game Date", | |
| choices = NULL, | |
| selected = NULL, | |
| multiple = FALSE, | |
| width = "250px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'new_pitch'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("new_pitch_pitcher", "Pitcher", | |
| choices = initial_pitcher_choices, | |
| selected = initial_pitcher_default), | |
| selectInput("new_pitch_pitcher_pitch_type", "Pitch Type", | |
| choices = unique(stuff_means$TaggedPitchType), | |
| selected = "Fastball", width = "125px" | |
| ), | |
| numericInput("hb", | |
| "HB", | |
| value = 0, | |
| min = -25, | |
| max = 25, | |
| step = 1, | |
| width = "80px" | |
| ), | |
| numericInput("ivb", | |
| "IVB", | |
| value = 0, | |
| min = -25, | |
| max = 25, | |
| step = 1, | |
| width = "80px" | |
| ), | |
| numericInput("velo", | |
| "Velocity", | |
| value = 85, | |
| min = 70, | |
| max = 100, | |
| step = 1, | |
| width = "80px" | |
| ) | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'stuffbymovement'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("stuff_pitcher", "Pitcher", choices = initial_pitcher_choices, selected = initial_pitcher_default, width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_leaders'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| dateRangeInput("date_range_pitchers", | |
| "Date Range", | |
| start = get_default_start_date(), | |
| end = Sys.Date(), | |
| format = "yyyy-mm-dd", | |
| width = "300px"), | |
| selectInput("table", "Select Table Type", | |
| choices = c("Pitcher Stats", "Pitcher Stats by Pitch Type"), | |
| selected = "Pitcher Stats", width = "150px" | |
| ), | |
| selectInput("side", "By Batter Side", | |
| choices = c("Any", "Right", "Left"), | |
| selected = "Any", width = "100px" | |
| ), | |
| numericInput("sample", | |
| "Min P", | |
| value = get_leaderboard_default("pitcher_p"), | |
| min = 10, | |
| max = 1000, | |
| step = 1, width = "50px" | |
| ), | |
| numericInput("bbe", | |
| "Min BBE", | |
| value = get_leaderboard_default("pitcher_bbe"), | |
| min = 0, | |
| max = 100, | |
| step = 1, width = "50px" | |
| ) | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pens'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("pens_pitcher", "Pitcher", | |
| choices = initial_pitcher_choices, | |
| selected = initial_pitcher_default, width = "150px"), | |
| selectizeInput("pens_dates", "Game Date", | |
| choices = NULL, | |
| selected = NULL, | |
| multiple = FALSE, | |
| width = "150px"), | |
| downloadButton("downloadPlot", "Download") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'sims'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("sim_pitcher", "Pitcher", | |
| choices = initial_pitcher_choices, | |
| selected = initial_pitcher_default, | |
| width = "150px"), | |
| selectizeInput("sim_pitcher_dates", "Date", | |
| choices = NULL, | |
| selected = NULL, | |
| multiple = FALSE, | |
| width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_similarity'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("similarity_pitcher", "Pitcher", | |
| choices = initial_pitcher_choices, | |
| selected = initial_pitcher_default, | |
| width = "150px"), | |
| selectizeInput("similarity_season", "Season", | |
| choices = NULL, | |
| selected = NULL, | |
| width = "150px"), | |
| selectizeInput("similarity_pitch_type", "Pitch Type", | |
| choices = NULL, | |
| selected = NULL, | |
| width = "150px"), | |
| selectInput("similarity_type", "Compare To", | |
| choices = c("MLB" = "mlb", "WVU" = "wvu"), | |
| selected = "mlb", | |
| width = "120px"), | |
| numericInput("similarity_top_n", "Top N", | |
| value = 15, | |
| min = 5, | |
| max = 50, | |
| width = "80px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'catching_defense'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectizeInput("catcher", "Catcher", | |
| choices = initial_catcher_choices, | |
| selected = initial_catcher_default, | |
| width = "150px"), | |
| selectizeInput("season_catchers", "Season", | |
| choices = get_available_seasons(), | |
| selected = get_default_season(), | |
| multiple = FALSE, | |
| width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'outfield_defense'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectInput("outfielder", "Fielder", | |
| choices = outfielders, selected = default_outfielder_selection, width = "250px" | |
| ), | |
| selectizeInput("season_outfield", "Season", | |
| choices = get_available_seasons(), | |
| selected = get_default_season(), | |
| multiple = FALSE, | |
| width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'infield_defense'", | |
| div( | |
| style = "display: flex; gap: 10px;", | |
| selectInput( | |
| "infielder", "Fielder", | |
| choices = infielders, | |
| selected = default_infielder_selection, width = "250px" | |
| ), | |
| selectizeInput("season_infield", "Season", | |
| choices = get_available_seasons(), | |
| selected = get_default_season(), | |
| multiple = FALSE, | |
| width = "150px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'scores'", | |
| div( | |
| id = "scores_controls", | |
| style = "display:flex; gap:10px; align-items:flex-end;", | |
| tags$style(HTML(" | |
| #scores_controls .form-group { | |
| width: 160px !important; | |
| margin-bottom: 0 !important; | |
| } | |
| #scores_controls .form-control, | |
| #scores_controls .selectize-input, | |
| #scores_controls .btn { | |
| height: 40px !important; | |
| min-height: 40px !important; | |
| } | |
| #scores_controls .selectize-input { | |
| display: flex !important; | |
| align-items: center !important; | |
| } | |
| #scores_controls .input-group-addon, | |
| #scores_controls .input-group-btn .btn { | |
| height: 40px !important; | |
| } | |
| #scores_controls .btn { | |
| width: 160px !important; | |
| } | |
| ")), | |
| dateInput( | |
| "scores_date", "Date", | |
| value = Sys.Date(), | |
| format = "yyyy-mm-dd", | |
| width = "160px" | |
| ), | |
| selectInput( | |
| "scores_view", "Games", | |
| choices = c( | |
| "All Games" = "all", | |
| "T25" = "t25", | |
| conference_game_choices | |
| ), | |
| selected = "all", | |
| width = "160px" | |
| ), | |
| div( | |
| class = "form-group", | |
| style = "width:160px; margin-bottom:0;", | |
| tags$label("\u00A0"), | |
| actionButton("refresh_scores", "Refresh", width = "160px") | |
| ) | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'standings'", | |
| div( | |
| id = "standings_controls", | |
| style = "display:flex; gap:10px; align-items:flex-end;", | |
| tags$style(HTML(" | |
| #standings_controls .form-group { | |
| width: 160px !important; | |
| margin-bottom: 0 !important; | |
| } | |
| #standings_controls .form-control, | |
| #standings_controls .selectize-input, | |
| #standings_controls .btn { | |
| height: 40px !important; | |
| min-height: 40px !important; | |
| } | |
| #standings_controls .selectize-input { | |
| display: flex !important; | |
| align-items: center !important; | |
| } | |
| #standings_controls .btn { | |
| width: 160px !important; | |
| } | |
| ")), | |
| selectInput( | |
| "standings_conference", "Conference", | |
| choices = c("All Conferences" = "all", conference_standings_choices), | |
| selected = "Big 12", | |
| width = "160px" | |
| ), | |
| div( | |
| class = "form-group", | |
| style = "width:160px; margin-bottom:0;", | |
| tags$label("\u00A0"), | |
| actionButton("refresh_standings", "Refresh", width = "160px") | |
| ) | |
| ) | |
| ) | |
| ) | |
| ), | |
| div( | |
| id = "main_content", | |
| style = "padding: 20px;", | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_summary'", | |
| fluidRow( | |
| column( | |
| width = 7, | |
| plotOutput("val_percentiles", height = "180px"), | |
| plotOutput("hit_percentiles", height = "560px"), | |
| uiOutput("field_percentiles_ui") | |
| ), | |
| column( | |
| width = 5, | |
| plotOutput("spray_chart", height = "410px"), | |
| plotOutput("rolling_xwoba", height = "400px") | |
| ) | |
| ), | |
| gt_output("hit_summary_overall"), | |
| gt_output("hit_summary"), | |
| gt_output("bb_profile"), | |
| gt_output("discipline"), | |
| plotOutput("row_1_hitter", height = "500px"), | |
| plotOutput("contact", height = "400px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_game'", | |
| gt_output("hitter_stats_by_game") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_zones'", | |
| plotOutput("hit_zones", height = "700px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_leaderboards'", | |
| DT::DTOutput("hitter_stats_table") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_pitch_level_filters'", | |
| DT::DTOutput("filtered_hitter_table") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'hitters_pitcher_level_filters'", | |
| DT::DTOutput("filtered_hitter_table_arsenal") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_summary'", | |
| fluidRow( | |
| column( | |
| width = 7, | |
| plotOutput("val_percentiles_pitcher", height = "250px"), | |
| plotOutput("pit_percentiles", height = "560px") | |
| ), | |
| column( | |
| width = 5, | |
| plotOutput("short_form", height = "410px"), | |
| plotOutput("rolling_xwoba_pit", height = "400px") | |
| ) | |
| ), | |
| gt_output("summary_overall"), | |
| gt_output("pitch_summary"), | |
| plotOutput("row_1_pitcher", height = "400px"), | |
| plotOutput("row_2_pitcher", height = "400px"), | |
| plotOutput("pitch_locations", height = "410px"), | |
| gt_output("pitch_summary_right"), | |
| gt_output("pitch_summary_left"), | |
| plotOutput("stuff_date", height = "400px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_by_date'", | |
| gt_output("summary_dates"), | |
| gt_output("summary_overall_dates"), | |
| plotOutput("movement_dates"), | |
| plotOutput("locs_game_l", height = "300px"), | |
| plotOutput("locs_game_r", height = "300px"), | |
| plotOutput("at_bats_game", height = "1200px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'new_pitch'", | |
| tagList( | |
| fluidRow( | |
| column( | |
| width = 6, | |
| gt_output("actual_pitch_stats") | |
| ), | |
| column( | |
| width = 6, | |
| gt_output("new_pitch_stats"), | |
| plotOutput("new_pitch_plot", height = "600px") | |
| ) | |
| ), | |
| plotOutput("new_pitch_shap_plot", height = "500px") | |
| ) | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'stuffbymovement'", | |
| plotOutput("stuff_movement_plot", height = "900px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_leaders'", | |
| DT::DTOutput("pitcher_stats_table") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pens'", | |
| gt_output("summary_dates_pen"), | |
| plotOutput("movement_dates_pen"), | |
| plotOutput("locs_pen", height = "300px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'sims'", | |
| gt_output("sim_summary"), | |
| plotOutput("sim_movement"), | |
| plotOutput("locs_sim_l", height = "300px"), | |
| plotOutput("locs_sim_r", height = "300px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'pitchers_similarity'", | |
| h4("Pitch Comparables"), | |
| gt_output("similarity_pitcher_info"), | |
| DT::DTOutput("similarity_table") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'catching_defense'", | |
| plotOutput("framing_plot", height = "900px") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'outfield_defense'", | |
| fluidRow( | |
| column( | |
| width = 6, | |
| plotOutput("star_plot", height = "580px") | |
| ), | |
| column( | |
| width = 6, | |
| plotlyOutput("all_catches", height = "290px"), | |
| plotOutput("direction", height = "290px") | |
| ) | |
| ), | |
| fluidRow( | |
| column( | |
| width = 12, | |
| gt_output("star_table") | |
| ) | |
| ), | |
| DT::DTOutput("ind_plays_oaa") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'infield_defense'", | |
| plotOutput("star_plot_inf", height = "600px", width = "950px"), | |
| gt_output("star_table_inf"), | |
| DT::DTOutput("ind_plays_oaa_inf") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'team_oaa'", | |
| DT::DTOutput("team_oaa_table") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'scores'", | |
| tags$style(HTML(" | |
| .scores-grid { | |
| display: grid; | |
| grid-template-columns: repeat(4, minmax(0, 1fr)); | |
| grid-auto-flow: row; | |
| align-content: start; | |
| gap: 12px; | |
| width: 100%; | |
| } | |
| .score-card { | |
| background: #ffffff; | |
| border: 1px solid #d7deea; | |
| border-radius: 10px; | |
| padding: 12px; | |
| box-shadow: 0 1px 2px rgba(0, 40, 85, 0.08); | |
| } | |
| .score-header { | |
| display: flex; | |
| flex-wrap: nowrap; | |
| align-items: center; | |
| gap: 6px; | |
| margin-bottom: 10px; | |
| } | |
| .score-status { | |
| display: inline-flex; | |
| align-items: center; | |
| line-height: 1; | |
| font-size: 11px; | |
| font-weight: 700; | |
| text-transform: uppercase; | |
| letter-spacing: 0.4px; | |
| border-radius: 999px; | |
| padding: 3px 8px; | |
| margin-bottom: 0; | |
| } | |
| .score-status--final { | |
| background: #dcfce7; | |
| color: #166534; | |
| } | |
| .score-status--live { | |
| background: #fee2e2; | |
| color: #b91c1c; | |
| } | |
| .score-status--upcoming { | |
| background: #fff4cc; | |
| color: #7a5a00; | |
| } | |
| .score-status--canceled { | |
| background: #eceff3; | |
| color: #4b5563; | |
| } | |
| .score-tag { | |
| display: inline-flex; | |
| align-items: center; | |
| line-height: 1; | |
| font-size: 11px; | |
| font-weight: 700; | |
| text-transform: uppercase; | |
| border-radius: 999px; | |
| padding: 3px 8px; | |
| } | |
| .score-tag--late { | |
| background: #ffedd5; | |
| color: #c2410c; | |
| } | |
| .score-tag--close { | |
| background: #fef3c7; | |
| color: #92400e; | |
| } | |
| .score-lines { | |
| display: grid; | |
| grid-template-columns: minmax(0, 1fr) auto auto; | |
| align-items: stretch; | |
| gap: 10px; | |
| margin: 4px 0; | |
| } | |
| .score-lines__teams, | |
| .score-lines__scores { | |
| display: grid; | |
| grid-template-rows: auto auto; | |
| gap: 8px; | |
| align-content: center; | |
| } | |
| .score-lines__inning { | |
| display: flex; | |
| align-items: center; | |
| justify-content: center; | |
| min-width: 38px; | |
| } | |
| .score-team, .score-score { | |
| color: #111827; | |
| font-size: 15px; | |
| } | |
| .score-inning { | |
| color: #475569; | |
| font-size: 15px; | |
| font-weight: 700; | |
| text-align: center; | |
| white-space: nowrap; | |
| } | |
| .score-team-main { | |
| display: inline-flex; | |
| align-items: center; | |
| gap: 6px; | |
| } | |
| .score-team-logo { | |
| width: 18px; | |
| height: 18px; | |
| object-fit: contain; | |
| flex-shrink: 0; | |
| } | |
| .score-score { | |
| font-weight: 700; | |
| text-align: right; | |
| } | |
| .score-team--winner, .score-score--winner { | |
| color: #15803d; | |
| font-weight: 700; | |
| } | |
| .score-team--leader-live, .score-score--leader-live { | |
| color: #1d4ed8; | |
| font-weight: 700; | |
| } | |
| .score-detail { | |
| margin-top: 8px; | |
| color: #4b5563; | |
| font-size: 12px; | |
| } | |
| .scores-empty { | |
| background: #ffffff; | |
| border: 1px solid #d7deea; | |
| border-radius: 10px; | |
| padding: 14px; | |
| color: #334155; | |
| } | |
| .standings-grid { | |
| display: grid; | |
| grid-template-columns: repeat(2, minmax(0, 1fr)); | |
| gap: 12px; | |
| width: 100%; | |
| } | |
| .standings-card { | |
| background: #ffffff; | |
| border: 1px solid #d7deea; | |
| border-radius: 10px; | |
| padding: 12px; | |
| box-shadow: 0 1px 2px rgba(0, 40, 85, 0.08); | |
| } | |
| .standings-title { | |
| font-size: 15px; | |
| font-weight: 700; | |
| color: #0f172a; | |
| margin-bottom: 8px; | |
| } | |
| .standings-table { | |
| width: 100%; | |
| border-collapse: collapse; | |
| font-size: 13px; | |
| } | |
| .standings-table th, | |
| .standings-table td { | |
| padding: 6px 4px; | |
| border-bottom: 1px solid #e2e8f0; | |
| text-align: left; | |
| color: #0f172a; | |
| vertical-align: middle; | |
| } | |
| .standings-table th { | |
| font-weight: 700; | |
| color: #334155; | |
| } | |
| .standings-table tr:last-child td { | |
| border-bottom: none; | |
| } | |
| .standings-team-main { | |
| display: inline-flex; | |
| align-items: center; | |
| gap: 6px; | |
| } | |
| .standings-team-logo { | |
| width: 16px; | |
| height: 16px; | |
| object-fit: contain; | |
| flex-shrink: 0; | |
| } | |
| @media (max-width: 1100px) { | |
| .standings-grid { | |
| grid-template-columns: minmax(0, 1fr); | |
| } | |
| } | |
| ")), | |
| uiOutput("scores_cards") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'standings'", | |
| uiOutput("standings_cards") | |
| ), | |
| conditionalPanel( | |
| condition = "input.current_view == 'glossary'", | |
| DT::DTOutput("glossary_table") | |
| ) | |
| ), | |
| tags$script(" | |
| $(document).ready(function() { | |
| // Hover functionality for dropdowns | |
| $('.nav-dropdown').hover(function() { | |
| $(this).find('div[id$=\"_submenu\"]').show(); | |
| }, function() { | |
| $(this).find('div[id$=\"_submenu\"]').hide(); | |
| }); | |
| // Initialize current view | |
| Shiny.setInputValue('current_view', 'hitters_summary'); | |
| }); | |
| // Handle submenu clicks | |
| $('#hitters_summary').click(function() { | |
| Shiny.setInputValue('current_view', 'hitters_summary'); | |
| $('#hitters_submenu').hide(); | |
| }); | |
| $('#hitters_game').click(function() { | |
| Shiny.setInputValue('current_view', 'hitters_game'); | |
| $('#hitters_submenu').hide(); | |
| }); | |
| $('#hitters_zones').click(function() { | |
| Shiny.setInputValue('current_view', 'hitters_zones'); | |
| $('#hitters_submenu').hide(); | |
| }); | |
| $('#hitters_leaderboards').click(function() { | |
| Shiny.setInputValue('current_view', 'hitters_leaderboards'); | |
| $('#hitters_submenu').hide(); | |
| }); | |
| $('#hitters_pitch_level_filters').click(function() { | |
| Shiny.setInputValue('current_view', 'hitters_pitch_level_filters'); | |
| $('#hitters_submenu').hide(); | |
| }); | |
| $('#hitters_pitcher_level_filters').click(function() { | |
| Shiny.setInputValue('current_view', 'hitters_pitcher_level_filters'); | |
| $('#hitters_submenu').hide(); | |
| }); | |
| $('#pitchers_summary').click(function() { | |
| Shiny.setInputValue('current_view', 'pitchers_summary'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#pitchers_by_date').click(function() { | |
| Shiny.setInputValue('current_view', 'pitchers_by_date'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#new_pitch').click(function() { | |
| Shiny.setInputValue('current_view', 'new_pitch'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#stuffbymovement').click(function() { | |
| Shiny.setInputValue('current_view', 'stuffbymovement'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#pitchers_leaders').click(function() { | |
| Shiny.setInputValue('current_view', 'pitchers_leaders'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#pens').click(function() { | |
| Shiny.setInputValue('current_view', 'pens'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#sims').click(function() { | |
| Shiny.setInputValue('current_view', 'sims'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#pitchers_similarity').click(function() { | |
| Shiny.setInputValue('current_view', 'pitchers_similarity'); | |
| $('#pitchers_submenu').hide(); | |
| }); | |
| $('#catching_defense').click(function() { | |
| Shiny.setInputValue('current_view', 'catching_defense'); | |
| $('#fielding_submenu').hide(); | |
| }); | |
| $('#outfield_defense').click(function() { | |
| Shiny.setInputValue('current_view', 'outfield_defense'); | |
| $('#fielding_submenu').hide(); | |
| }); | |
| $('#infield_defense').click(function() { | |
| Shiny.setInputValue('current_view', 'infield_defense'); | |
| $('#fielding_submenu').hide(); | |
| }); | |
| $('#pens').click(function() { | |
| Shiny.setInputValue('current_view', 'pens'); | |
| $('#fielding_submenu').hide(); | |
| }); | |
| $('#team_oaa').click(function() { | |
| Shiny.setInputValue('current_view', 'team_oaa'); | |
| $('#fielding_submenu').hide(); | |
| }); | |
| $('#glossary').click(function() { | |
| Shiny.setInputValue('current_view', 'glossary'); | |
| }); | |
| $('#scores_main').click(function() { | |
| Shiny.setInputValue('current_view', 'scores'); | |
| }); | |
| $('#scores_games').click(function() { | |
| Shiny.setInputValue('current_view', 'scores'); | |
| $('#scores_submenu').hide(); | |
| }); | |
| $('#scores_standings').click(function() { | |
| Shiny.setInputValue('current_view', 'standings'); | |
| $('#scores_submenu').hide(); | |
| }); | |
| ") | |
| ) | |
| } | |
| }) | |
| output$field_percentiles_ui <- renderUI({ | |
| height_px <- "70px" | |
| if (!is.null(current_hitter_selection("player")) && !is.null(input$season)) { | |
| selected_ids <- current_hitter_ids("player") | |
| field_row <- defense %>% | |
| dplyr::filter(id %in% selected_ids, Season == input$season) | |
| has_oaa <- nrow(field_row) > 0 && any(!is.na(field_row$OAA)) | |
| has_frv <- nrow(field_row) > 0 && any(!is.na(field_row$frv)) | |
| if (has_oaa && has_frv) { | |
| height_px <- "100px" | |
| } | |
| } | |
| plotOutput("field_percentiles", height = height_px) | |
| }) | |
| output$val_percentiles <- bind_app_cache( | |
| renderPlot({ | |
| hitter_summary_bundle()$val_percentiles | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$hit_percentiles <- bind_app_cache( | |
| renderPlot({ | |
| hitter_summary_bundle()$hit_percentiles | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$field_percentiles <- bind_app_cache( | |
| renderPlot({ | |
| hitter_summary_bundle()$field_percentiles | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$spray_chart <- bind_app_cache( | |
| renderPlot({ | |
| hitter_summary_bundle()$spray_chart | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$rolling_xwoba <- bind_app_cache( | |
| renderPlot({ | |
| hitter_summary_bundle()$rolling_xwoba | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$radial <- bind_app_cache( | |
| renderPlot({ | |
| hitter_summary_bundle()$radial | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$hit_summary_overall <- bind_app_cache( | |
| render_gt({ | |
| hitter_summary_bundle()$hit_summary_overall | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$hit_summary <- bind_app_cache( | |
| render_gt({ | |
| hitter_summary_bundle()$hit_summary | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$bb_profile <- bind_app_cache( | |
| render_gt({ | |
| hitter_summary_bundle()$bb_profile | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$discipline <- bind_app_cache( | |
| render_gt({ | |
| hitter_summary_bundle()$discipline | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$row_1_hitter <- bind_app_cache( | |
| renderPlot({ | |
| grid::grid.newpage() | |
| grid::grid.draw(hitter_summary_bundle()$row_1_hitter) | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$contact <- bind_app_cache( | |
| renderPlot({ | |
| hitter_summary_bundle()$contact | |
| }), | |
| player_scope(), | |
| current_hitter_selection("player"), | |
| input$season | |
| ) | |
| output$pit_percentiles <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| pitcher_percentiles( | |
| ctx$data, | |
| ctx$name, | |
| ctx$season, | |
| pitcher_ids = ctx$ids | |
| ) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$val_percentiles_pitcher <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| value_percentiles_pitcher( | |
| ctx$name, | |
| pit_war, | |
| ctx$data, | |
| ctx$season, | |
| pitcher_ids = ctx$ids | |
| ) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$short_form <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| movement(ctx$data, ctx$name) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$row_1_pitcher <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| p1 <- long_form(ctx$data, ctx$name) | |
| p2 <- release_points(ctx$data, ctx$name) | |
| p3 <- velo(ctx$data, ctx$name) | |
| grid.arrange(p1, p2, p3, ncol = 3) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$row_2_pitcher <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| p1 <- count_usage(ctx$data, ctx$name) | |
| p2 <- plot_pitch_type_freq(ctx$data, ctx$name) | |
| p3 <- tilt(ctx$data, ctx$name) | |
| grid.arrange(p1, p2, p3, ncol = 3) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$pitch_locations <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| locations(ctx$data, ctx$name) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$stuff_date <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| stuff_by_date(ctx$data, ctx$name) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$rolling_xwoba_pit <- bind_app_cache( | |
| renderPlot({ | |
| ctx <- pitcher_summary_context() | |
| rolling_xwOBA_pitcher(ctx$data, ctx$name) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$summary_overall <- bind_app_cache( | |
| render_gt({ | |
| ctx <- pitcher_summary_context() | |
| pitch_summary_overall( | |
| ctx$data, | |
| ctx$name, | |
| ctx$season, | |
| pitcher_stats, | |
| pitcher_ids = ctx$ids | |
| ) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$pitch_summary <- bind_app_cache( | |
| render_gt({ | |
| ctx <- pitcher_summary_context() | |
| pitch_summary(ctx$data, ctx$name) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$pitch_summary_right <- bind_app_cache( | |
| render_gt({ | |
| ctx <- pitcher_summary_context() | |
| pitch_summary_side(ctx$data, ctx$name, "Right") | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| output$pitch_summary_left <- bind_app_cache( | |
| render_gt({ | |
| ctx <- pitcher_summary_context() | |
| pitch_summary_side(ctx$data, ctx$name, "Left") | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pitcher"), | |
| input$season_pitchers | |
| ) | |
| observeEvent(input$Pitcher_dates, { | |
| req(isTruthy(exact_pitcher_selection("Pitcher_dates"))) | |
| available_games <- pitcher_by_date_game_choices() | |
| game_choices <- stats::setNames(available_games$game_key, available_games$game_label) | |
| selected_game <- if (nrow(available_games) == 0) { | |
| character(0) | |
| } else if (isTruthy(input$Pitcher_game_dates) && input$Pitcher_game_dates %in% available_games$game_key) { | |
| input$Pitcher_game_dates | |
| } else { | |
| available_games$game_key[[1]] | |
| } | |
| updateSelectInput( | |
| session, | |
| "Pitcher_game_dates", | |
| choices = game_choices, | |
| selected = selected_game | |
| ) | |
| }) | |
| observeEvent(input$Pitcher_game_dates, { | |
| req(isTruthy(exact_pitcher_selection("Pitcher_dates")), input$Pitcher_game_dates) | |
| selected_name <- exact_pitcher_name("Pitcher_dates") | |
| filtered_df <- pitcher_by_date_selected_data() | |
| output$movement_dates <- bind_app_cache( | |
| renderPlot({ | |
| p1 <- movement(filtered_df, selected_name, FALSE) | |
| p2 <- release_points(filtered_df, selected_name) | |
| p3 <- velo(filtered_df, selected_name) | |
| grid.arrange(p1, p2, p3, ncol = 3) | |
| }), | |
| player_scope(), | |
| exact_pitcher_selection("Pitcher_dates"), | |
| input$Pitcher_game_dates | |
| ) | |
| output$summary_dates <- bind_app_cache( | |
| render_gt({ | |
| pitch_summary(filtered_df, selected_name) | |
| }), | |
| player_scope(), | |
| exact_pitcher_selection("Pitcher_dates"), | |
| input$Pitcher_game_dates | |
| ) | |
| output$summary_overall_dates <- bind_app_cache( | |
| render_gt({ | |
| pitch_summary_game(filtered_df, selected_name) | |
| }), | |
| player_scope(), | |
| exact_pitcher_selection("Pitcher_dates"), | |
| input$Pitcher_game_dates | |
| ) | |
| output$at_bats_game <- bind_app_cache( | |
| renderPlot({ | |
| at_bats(filtered_df, selected_name) | |
| }), | |
| player_scope(), | |
| exact_pitcher_selection("Pitcher_dates"), | |
| input$Pitcher_game_dates | |
| ) | |
| output$locs_game_l <- bind_app_cache( | |
| renderPlot({ | |
| locations_game(filtered_df, selected_name, "Left") | |
| }), | |
| player_scope(), | |
| exact_pitcher_selection("Pitcher_dates"), | |
| input$Pitcher_game_dates, | |
| "Left" | |
| ) | |
| output$locs_game_r <- bind_app_cache( | |
| renderPlot({ | |
| locations_game(filtered_df, selected_name, "Right") | |
| }), | |
| player_scope(), | |
| exact_pitcher_selection("Pitcher_dates"), | |
| input$Pitcher_game_dates, | |
| "Right" | |
| ) | |
| }) | |
| observeEvent(input$hitter_by_game, { | |
| req(current_hitter_selection("hitter_by_game")) | |
| available_games_hitters <- hitter_game_choices() | |
| if (is.data.frame(available_games_hitters)) { | |
| game_choices <- stats::setNames(available_games_hitters$game_key, available_games_hitters$game_label) | |
| selected_game <- if (nrow(available_games_hitters) == 0) { | |
| character(0) | |
| } else { | |
| available_games_hitters$game_key[[1]] | |
| } | |
| } else { | |
| game_choices <- available_games_hitters | |
| selected_game <- if (length(game_choices) == 0) character(0) else unname(game_choices[[1]]) | |
| } | |
| updateSelectInput( | |
| session, | |
| "hitter_game_dates", | |
| choices = game_choices, | |
| selected = selected_game | |
| ) | |
| }) | |
| observeEvent(input$hitter_game_dates, { | |
| req(current_hitter_selection("hitter_by_game"), input$hitter_game_dates) | |
| output$hitter_stats_by_game <- bind_app_cache( | |
| render_gt({ | |
| hitter_game( | |
| hitter_game_data(), | |
| current_hitter_name("hitter_by_game"), | |
| input$hitter_game_dates, | |
| batter_ids = current_hitter_ids("hitter_by_game") | |
| ) | |
| }), | |
| player_scope(), | |
| current_hitter_selection("hitter_by_game"), | |
| input$hitter_game_dates | |
| ) | |
| }) | |
| output$hit_zones <- bind_app_cache( | |
| renderPlot({ | |
| req(current_hitter_selection("hitter_zone"), input$stat_zones) | |
| zone_data <- hitter_zone_data() | |
| selected_name <- current_hitter_name("hitter_zone") | |
| p1 <- ev_map(zone_data, selected_name, input$stat_zones) | |
| p2 <- zone_map(zone_data, selected_name, input$type_zones) | |
| grid.arrange(p1, p2, ncol = 2) | |
| }), | |
| player_scope(), | |
| current_hitter_selection("hitter_zone"), | |
| input$stat_zones, | |
| input$type_zones, | |
| input$side_zones | |
| ) | |
| observeEvent( | |
| list(input$current_view, input$scores_date, input$refresh_scores), | |
| { | |
| req(identical(input$current_view, "scores"), input$scores_date) | |
| scores <- fetch_espn_scoreboard(input$scores_date) | |
| scores_data_rv(scores) | |
| scores_error_rv(attr(scores, "fetch_error")) | |
| base_choices <- c( | |
| "All Games" = "all", | |
| "T25" = "t25" | |
| ) | |
| view_choices <- c(base_choices, conference_game_choices) | |
| current_view <- input$scores_view %||% "all" | |
| if (!(current_view %in% unname(view_choices))) { | |
| current_view <- "all" | |
| } | |
| updateSelectInput(session, "scores_view", choices = view_choices, selected = current_view) | |
| }, | |
| ignoreInit = FALSE | |
| ) | |
| observeEvent( | |
| list(input$current_view, input$refresh_standings), | |
| { | |
| req(identical(input$current_view, "standings")) | |
| season_value <- suppressWarnings(as.integer(format(Sys.Date(), "%Y"))) | |
| standings <- fetch_d1baseball_standings(season = season_value) | |
| if (nrow(standings) == 0) { | |
| standings <- fetch_local_standings(season = season_value) | |
| } | |
| standings_data_rv(standings) | |
| standings_error_rv(attr(standings, "fetch_error")) | |
| choices <- c("All Conferences" = "all", conference_standings_choices) | |
| selected <- input$standings_conference %||% "all" | |
| if (!(selected %in% unname(choices))) { | |
| selected <- "all" | |
| } | |
| updateSelectInput(session, "standings_conference", choices = choices, selected = selected) | |
| }, | |
| ignoreInit = FALSE | |
| ) | |
| output$scores_cards <- bind_app_cache(renderUI({ | |
| req(input$current_view == "scores", input$scores_date, input$scores_view) | |
| scores <- scores_data_rv() | |
| fetch_error <- scores_error_rv() | |
| view_key <- input$scores_view %||% "all" | |
| if (nrow(scores) > 0) { | |
| if (view_key %in% c("t25", "T25")) { | |
| scores <- scores %>% filter(top25_game) | |
| } else if (startsWith(view_key, "conference::")) { | |
| conference_name <- sub("^conference::", "", view_key) | |
| scores <- scores %>% filter(away_conference == conference_name | home_conference == conference_name) | |
| } else if (!(view_key %in% c("all", "All Games"))) { | |
| scores <- scores %>% filter(away_conference == view_key | home_conference == view_key) | |
| } | |
| } | |
| if (!("start_datetime_utc" %in% names(scores))) { | |
| scores$start_datetime_utc <- NA_character_ | |
| } | |
| if (!("start_time" %in% names(scores))) { | |
| scores$start_time <- NA_character_ | |
| } | |
| if (!("start_sort_key" %in% names(scores))) { | |
| scores$start_sort_key <- NA_real_ | |
| } | |
| if (!("start_time_minutes" %in% names(scores))) { | |
| scores$start_time_minutes <- NA_real_ | |
| } | |
| if (nrow(scores) == 0) { | |
| message_text <- if (!is.null(fetch_error)) { | |
| fetch_error | |
| } else { | |
| paste0("No games found for ", as.character(as.Date(input$scores_date)), ".") | |
| } | |
| return(div(class = "scores-empty", message_text)) | |
| } | |
| cards <- lapply(seq_len(nrow(scores)), function(i) { | |
| game <- scores[i, ] | |
| is_live <- identical(game$status_category[[1]], "live") | |
| away_is_winner <- identical(game$winner[[1]], "away") | |
| home_is_winner <- identical(game$winner[[1]], "home") | |
| away_is_live_leader <- is_live && !is.na(game$away_score[[1]]) && !is.na(game$home_score[[1]]) && game$away_score[[1]] > game$home_score[[1]] | |
| home_is_live_leader <- is_live && !is.na(game$away_score[[1]]) && !is.na(game$home_score[[1]]) && game$home_score[[1]] > game$away_score[[1]] | |
| away_school <- if ("away_school" %in% names(game) && !is.na(game$away_school[[1]]) && nzchar(game$away_school[[1]])) { | |
| game$away_school[[1]] | |
| } else { | |
| game$away[[1]] | |
| } | |
| home_school <- if ("home_school" %in% names(game) && !is.na(game$home_school[[1]]) && nzchar(game$home_school[[1]])) { | |
| game$home_school[[1]] | |
| } else { | |
| game$home[[1]] | |
| } | |
| away_record_suffix <- if ("away_record" %in% names(game) && !is.na(game$away_record[[1]]) && nzchar(game$away_record[[1]])) { | |
| paste0(" (", game$away_record[[1]], ")") | |
| } else { | |
| "" | |
| } | |
| home_record_suffix <- if ("home_record" %in% names(game) && !is.na(game$home_record[[1]]) && nzchar(game$home_record[[1]])) { | |
| paste0(" (", game$home_record[[1]], ")") | |
| } else { | |
| "" | |
| } | |
| away_label <- if (!is.na(game$away_rank[[1]])) { | |
| paste0("#", game$away_rank[[1]], " ", away_school, away_record_suffix) | |
| } else { | |
| paste0(away_school, away_record_suffix) | |
| } | |
| home_label <- if (!is.na(game$home_rank[[1]])) { | |
| paste0("#", game$home_rank[[1]], " ", home_school, home_record_suffix) | |
| } else { | |
| paste0(home_school, home_record_suffix) | |
| } | |
| away_name_node <- tags$span( | |
| class = "score-team-main", | |
| if (!is.na(game$away_logo[[1]]) && nzchar(game$away_logo[[1]])) { | |
| tags$img(src = game$away_logo[[1]], class = "score-team-logo", alt = game$away[[1]]) | |
| } else { | |
| NULL | |
| }, | |
| tags$span(class = "score-team-text", away_label) | |
| ) | |
| home_name_node <- tags$span( | |
| class = "score-team-main", | |
| if (!is.na(game$home_logo[[1]]) && nzchar(game$home_logo[[1]])) { | |
| tags$img(src = game$home_logo[[1]], class = "score-team-logo", alt = game$home[[1]]) | |
| } else { | |
| NULL | |
| }, | |
| tags$span(class = "score-team-text", home_label) | |
| ) | |
| inning_text <- if (!is.na(game$inning_display[[1]]) && nzchar(game$inning_display[[1]])) game$inning_display[[1]] else "-" | |
| inning_arrow <- game$inning_arrow[[1]] %||% "" | |
| inning_markup <- dplyr::case_when( | |
| inning_arrow == "up" ~ paste0(inning_text, " ↑"), | |
| inning_arrow == "down" ~ paste0(inning_text, " ↓"), | |
| TRUE ~ inning_text | |
| ) | |
| game_start_time <- if ("start_time" %in% names(game) && !is.na(game$start_time[[1]])) game$start_time[[1]] else "" | |
| game_location <- if ("location" %in% names(game) && !is.na(game$location[[1]])) game$location[[1]] else "" | |
| footer_text <- dplyr::case_when( | |
| game$status_category[[1]] == "upcoming" && nzchar(game_start_time) && nzchar(game_location) ~ paste(game_start_time, game_location, sep = " | "), | |
| game$status_category[[1]] == "upcoming" && nzchar(game_start_time) ~ game_start_time, | |
| nzchar(game_location) ~ game_location, | |
| TRUE ~ "" | |
| ) | |
| status_class <- paste("score-status", paste0("score-status--", game$status_category[[1]])) | |
| live_tags <- list() | |
| if (isTRUE(game$live_late[[1]])) { | |
| live_tags <- append(live_tags, list(tags$span(class = "score-tag score-tag--late", "Late"))) | |
| } | |
| if (isTRUE(game$live_close[[1]])) { | |
| live_tags <- append(live_tags, list(tags$span(class = "score-tag score-tag--close", "Close"))) | |
| } | |
| header <- do.call( | |
| tags$div, | |
| c( | |
| list(class = "score-header", tags$span(class = status_class, game$status_label[[1]])), | |
| live_tags | |
| ) | |
| ) | |
| away_team_class <- dplyr::case_when( | |
| away_is_winner ~ "score-team score-team--winner", | |
| away_is_live_leader ~ "score-team score-team--leader-live", | |
| TRUE ~ "score-team" | |
| ) | |
| away_score_class <- dplyr::case_when( | |
| away_is_winner ~ "score-score score-score--winner", | |
| away_is_live_leader ~ "score-score score-score--leader-live", | |
| TRUE ~ "score-score" | |
| ) | |
| home_team_class <- dplyr::case_when( | |
| home_is_winner ~ "score-team score-team--winner", | |
| home_is_live_leader ~ "score-team score-team--leader-live", | |
| TRUE ~ "score-team" | |
| ) | |
| home_score_class <- dplyr::case_when( | |
| home_is_winner ~ "score-score score-score--winner", | |
| home_is_live_leader ~ "score-score score-score--leader-live", | |
| TRUE ~ "score-score" | |
| ) | |
| tags$div( | |
| class = "score-card", | |
| header, | |
| tags$div( | |
| class = "score-lines", | |
| tags$div( | |
| class = "score-lines__teams", | |
| tags$span(class = away_team_class, away_name_node), | |
| tags$span(class = home_team_class, home_name_node) | |
| ), | |
| tags$div( | |
| class = "score-lines__inning", | |
| tags$span(class = "score-inning", HTML(inning_markup)) | |
| ), | |
| tags$div( | |
| class = "score-lines__scores", | |
| tags$span(class = away_score_class, game$away_score_display[[1]]), | |
| tags$span(class = home_score_class, game$home_score_display[[1]]) | |
| ) | |
| ), | |
| if (nzchar(footer_text)) { | |
| tags$div(class = "score-detail", footer_text) | |
| } else { | |
| NULL | |
| } | |
| ) | |
| }) | |
| tags$div(class = "scores-grid", cards) | |
| }), | |
| input$current_view, | |
| input$scores_date, | |
| input$scores_view, | |
| input$refresh_scores | |
| ) | |
| output$standings_cards <- bind_app_cache(renderUI({ | |
| req(input$current_view == "standings", input$standings_conference) | |
| standings <- standings_data_rv() | |
| standings_error <- standings_error_rv() | |
| if (nrow(standings) == 0) { | |
| message_text <- if (!is.null(standings_error)) { | |
| if (identical(standings_error, "No standings found.")) { | |
| paste0("No standings found for ", format(Sys.Date(), "%Y"), ".") | |
| } else { | |
| standings_error | |
| } | |
| } else { | |
| "No standings data available." | |
| } | |
| return(div(class = "scores-empty", message_text)) | |
| } | |
| selected_conf <- input$standings_conference %||% "all" | |
| if (!identical(selected_conf, "all")) { | |
| standings <- standings %>% | |
| dplyr::filter(conference == selected_conf) | |
| } | |
| if (nrow(standings) == 0) { | |
| return(div(class = "scores-empty", "No standings data for selected conference.")) | |
| } | |
| conferences <- unique(standings$conference) | |
| conferences <- conferences[!is.na(conferences) & nzchar(conferences)] | |
| standings_cards <- lapply(conferences, function(conf_name) { | |
| conf_tbl <- standings %>% | |
| dplyr::filter(conference == conf_name) %>% | |
| dplyr::arrange(display_rank, team) | |
| rows <- lapply(seq_len(nrow(conf_tbl)), function(i) { | |
| team_logo <- conf_tbl$team_logo[[i]] | |
| team_name <- conf_tbl$team[[i]] | |
| team_key <- normalize_team_name(team_name) | |
| is_wvu <- team_key %in% c("west virginia", "west virginia mountaineers", "wvu") | |
| row_style <- if (is_wvu) "background-color:#EAAA00;color:#002855;font-weight:700;" else NULL | |
| conf_record <- conf_tbl$conference_record[[i]] | |
| overall_record <- conf_tbl$overall_record[[i]] | |
| conf_record <- if (!is.na(conf_record) && nzchar(conf_record)) conf_record else "-" | |
| overall_record <- if (!is.na(overall_record) && nzchar(overall_record)) overall_record else "-" | |
| team_node <- tags$span( | |
| class = "standings-team-main", | |
| if (!is.na(team_logo) && nzchar(team_logo)) { | |
| tags$img(src = team_logo, class = "standings-team-logo", alt = team_name) | |
| } else { | |
| NULL | |
| }, | |
| tags$span(team_name) | |
| ) | |
| tags$tr( | |
| style = row_style, | |
| tags$td(conf_tbl$display_rank[[i]]), | |
| tags$td(team_node), | |
| tags$td(conf_record), | |
| tags$td(overall_record) | |
| ) | |
| }) | |
| tags$div( | |
| class = "standings-card", | |
| tags$div(class = "standings-title", conf_name), | |
| tags$table( | |
| class = "standings-table", | |
| tags$thead( | |
| tags$tr( | |
| tags$th("Rk"), | |
| tags$th("Team"), | |
| tags$th("Conf"), | |
| tags$th("Overall") | |
| ) | |
| ), | |
| do.call(tags$tbody, rows) | |
| ) | |
| ) | |
| }) | |
| tags$div(class = "standings-grid", standings_cards) | |
| }), | |
| input$current_view, | |
| input$standings_conference, | |
| input$refresh_standings | |
| ) | |
| output$hitter_stats_table <- bind_app_cache( | |
| DT::renderDT({ | |
| req(input$pthrows, input$table_type, input$sample_pa, input$bbe_hit) | |
| df <- hitter_leaderboard_data() | |
| table <- if (input$table_type == "Hitter Stats") { | |
| hitter_table(df) %>% | |
| filter(PA >= input$sample_pa, `Batted Balls` >= input$bbe_hit) | |
| } else { | |
| hitter_table_by_hand(df) %>% | |
| filter(PA >= input$sample_pa, `Batted Balls` >= input$bbe_hit) | |
| } | |
| player_fixed_datatable(table, page_length = 20, filter = "top") | |
| }), | |
| player_scope(), | |
| input$pthrows, | |
| input$date_range_hitters, | |
| input$table_type, | |
| input$sample_pa, | |
| input$bbe_hit | |
| ) | |
| output$filtered_hitter_table <- bind_app_cache( | |
| DT::renderDT({ | |
| req(input$filter_col1, input$filter_op1, input$filter_val1) | |
| df <- hitter_filter_data() | |
| col_map <- c( | |
| "Balls" = "Balls", | |
| "Strikes" = "Strikes", | |
| "Outs" = "Outs", | |
| "Inning" = "Inning", | |
| "Velocity" = "RelSpeed", | |
| "IVB" = "InducedVertBreak", | |
| "HB" = "HorzBreak", | |
| "Spin" = "SpinRate", | |
| "RelHeight" = "RelHeight", | |
| "RelSide" = "RelSide", | |
| "VAA" = "VertApprAngle" | |
| ) | |
| col <- col_map[[input$filter_col1]] | |
| op <- input$filter_op1 | |
| val <- as.numeric(input$filter_val1) | |
| expr_text <- paste0("`", col, "`", op,val) | |
| expr <- parse(text = expr_text) | |
| df_filtered <- df %>% | |
| filter(eval(expr)) | |
| df_filtered <- df_filtered %>% | |
| filter({ | |
| locs <- input$hitter_location | |
| if (is.null(locs) || "Any" %in% locs) { | |
| TRUE | |
| } else { | |
| conds <- list() | |
| if ("Inside" %in% locs) { | |
| conds <- append(conds, list( | |
| (PlateLocSide > 0 & BatterSide == "Right") | (PlateLocSide < 0 & BatterSide == "Left") | |
| )) | |
| } | |
| if ("Outside" %in% locs) { | |
| conds <- append(conds, list( | |
| (PlateLocSide < 0 & BatterSide == "Right") | (PlateLocSide > 0 & BatterSide == "Left") | |
| )) | |
| } | |
| if ("Up" %in% locs) { | |
| conds <- append(conds, list(PlateLocHeight > 30)) | |
| } | |
| if ("Down" %in% locs) { | |
| conds <- append(conds, list(PlateLocHeight <= 30)) | |
| } | |
| Reduce(`&`, conds) | |
| } | |
| }) | |
| table_filt <- hitter_table_filter(df_filtered) | |
| player_fixed_datatable(table_filt, page_length = 20, filter = "top") | |
| }), | |
| player_scope(), | |
| input$side_filter, | |
| input$type_filter, | |
| input$loc_filter, | |
| input$filter_col1, | |
| input$filter_op1, | |
| input$filter_val1, | |
| input$hitter_location | |
| ) | |
| output$filtered_hitter_table_arsenal <- bind_app_cache( | |
| DT::renderDT({ | |
| req(input$filter_col2, input$filter_op2, input$filter_val2) | |
| df <- hitter_arsenal_data() | |
| col_map2 <- c( | |
| "Velocity" = "RelSpeed", | |
| "IVB" = "InducedVertBreak", | |
| "HB" = "HorzBreak", | |
| "Spin" = "SpinRate", | |
| "RelHeight" = "RelHeight", | |
| "RelSide" = "RelSide", | |
| "VAA" = "VertApprAngle" | |
| ) | |
| col <- col_map2[["Velocity"]] | |
| op <- ">=" | |
| val <- as.numeric(90) | |
| arsenal_summary <- df %>% | |
| group_by(Pitcher, TaggedPitchType) %>% | |
| summarise(across(all_of(unname(col_map2)), ~ mean(.x, na.rm = TRUE)), .groups = "drop") | |
| expr_text <- paste0("`", col, "`", op,val) | |
| expr <- parse(text = expr_text) | |
| arsenal_summary <- arsenal_summary %>% | |
| filter(eval(expr)) | |
| arsenal_pitchers <- unique(arsenal_summary$Pitcher) | |
| df_filtered <- df %>% | |
| filter(Pitcher %in% arsenal_pitchers) | |
| df_filtered <- df_filtered %>% | |
| filter({ | |
| locs <- input$hitter_location2 | |
| if (is.null(locs) || "Any" %in% locs) { | |
| TRUE | |
| } else { | |
| conds <- list() | |
| if ("Inside" %in% locs) { | |
| conds <- append(conds, list( | |
| (PlateLocSide > 0 & BatterSide == "Right") | (PlateLocSide < 0 & BatterSide == "Left") | |
| )) | |
| } | |
| if ("Outside" %in% locs) { | |
| conds <- append(conds, list( | |
| (PlateLocSide < 0 & BatterSide == "Right") | (PlateLocSide > 0 & BatterSide == "Left") | |
| )) | |
| } | |
| if ("Up" %in% locs) { | |
| conds <- append(conds, list(PlateLocHeight > 30)) | |
| } | |
| if ("Down" %in% locs) { | |
| conds <- append(conds, list(PlateLocHeight <= 30)) | |
| } | |
| Reduce(`&`, conds) | |
| } | |
| }) | |
| table_filt <- hitter_table_filter(df_filtered) | |
| player_fixed_datatable(table_filt, page_length = 20, filter = "top") | |
| }), | |
| player_scope(), | |
| input$side_filter2, | |
| input$type_filter2, | |
| input$loc_filter2, | |
| input$filter_col2, | |
| input$filter_op2, | |
| input$filter_val2, | |
| input$hitter_location2 | |
| ) | |
| output$actual_pitch_stats <- bind_app_cache( | |
| render_gt({ | |
| actual_pitches_stuff(current_pitcher_name("new_pitch_pitcher")) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("new_pitch_pitcher") | |
| ) | |
| observeEvent(input$new_pitch_pitcher, { | |
| req(current_pitcher_selection("new_pitch_pitcher")) | |
| defaults <- get_new_pitch_defaults(current_pitcher_name("new_pitch_pitcher")) | |
| updateSelectInput( | |
| session, | |
| "new_pitch_pitcher_pitch_type", | |
| selected = defaults$pitch_type | |
| ) | |
| updateNumericInput(session, "hb", value = defaults$hb) | |
| updateNumericInput(session, "ivb", value = defaults$ivb) | |
| updateNumericInput(session, "velo", value = defaults$velo) | |
| }, ignoreInit = FALSE) | |
| output$new_pitch_stats <- bind_app_cache( | |
| render_gt({ | |
| new_pitch_stuff(current_pitcher_name("new_pitch_pitcher"), input$new_pitch_pitcher_pitch_type, | |
| input$hb, input$ivb, input$velo) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("new_pitch_pitcher"), | |
| input$new_pitch_pitcher_pitch_type, | |
| input$hb, | |
| input$ivb, | |
| input$velo | |
| ) | |
| output$new_pitch_plot <- bind_app_cache( | |
| renderPlot({ | |
| new_pitch_plot(current_pitcher_name("new_pitch_pitcher"), input$new_pitch_pitcher_pitch_type, | |
| input$hb, input$ivb) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("new_pitch_pitcher"), | |
| input$new_pitch_pitcher_pitch_type, | |
| input$hb, | |
| input$ivb | |
| ) | |
| output$new_pitch_shap_plot <- bind_app_cache( | |
| renderPlot({ | |
| new_pitch_shap_plot( | |
| current_pitcher_name("new_pitch_pitcher"), | |
| input$new_pitch_pitcher_pitch_type, | |
| input$hb, | |
| input$ivb, | |
| input$velo | |
| ) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("new_pitch_pitcher"), | |
| input$new_pitch_pitcher_pitch_type, | |
| input$hb, | |
| input$ivb, | |
| input$velo | |
| ) | |
| output$stuff_movement_plot <- bind_app_cache( | |
| renderPlot({ | |
| stuff_movement(stuff_movement_data(), current_pitcher_name("stuff_pitcher")) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("stuff_pitcher") | |
| ) | |
| output$pitcher_stats_table <- bind_app_cache( | |
| renderDT({ | |
| filtered_df <- pitcher_leaderboard_data() | |
| if (input$table == "Pitcher Stats") { | |
| table <- pitcher_table(filtered_df) %>% | |
| filter(P >= input$sample & BBE >= input$bbe) %>% | |
| mutate(IP = case_when( | |
| abs(IP %% 1 - 0.33) < 0.01 ~ floor(IP) + 0.1, | |
| abs(IP %% 1 - 0.67) < 0.01 ~ floor(IP) + 0.2, | |
| TRUE ~ IP | |
| )) | |
| player_fixed_datatable(table, page_length = 20, filter = "top") | |
| } else { | |
| table2 <- pitcher_table_by_hand(filtered_df) %>% | |
| filter(P >= input$sample & BBE >= input$bbe) %>% | |
| mutate(IP = case_when( | |
| abs(IP %% 1 - 0.33) < 0.01 ~ floor(IP) + 0.1, | |
| abs(IP %% 1 - 0.67) < 0.01 ~ floor(IP) + 0.2, | |
| TRUE ~ IP | |
| )) | |
| player_fixed_datatable(table2, page_length = 20, filter = "top") | |
| } | |
| }), | |
| player_scope(), | |
| input$date_range_pitchers, | |
| input$side, | |
| input$table, | |
| input$sample, | |
| input$bbe | |
| ) | |
| output$framing_plot <- bind_app_cache(renderPlot({ | |
| req(input$season_catchers, input$catcher) | |
| selected_season <- input$season_catchers | |
| selected_catcher <- selected_catcher_name(input$catcher) | |
| catcher_df <- catcher_view_data() | |
| empty_plot <- function(msg = "No data available") { | |
| ggplot() + | |
| annotate("text", x = 0.5, y = 0.5, label = msg, | |
| size = 6, color = wvu_blue, fontface = "bold") + | |
| theme_void() + | |
| theme(plot.background = element_rect(fill = "white", color = NA)) | |
| } | |
| if (nrow(catcher_df) == 0) { | |
| return(empty_plot(paste0("No data available for ", selected_catcher, "\nin ", selected_season))) | |
| } | |
| p1 <- tryCatch(framing_by_zone(catcher_df, selected_catcher), error = function(e) empty_plot("Framing data unavailable")) | |
| p2 <- tryCatch(framing_by_zone(catcher_df, selected_catcher, TRUE), error = function(e) empty_plot("Framing data unavailable")) | |
| p3 <- tryCatch(plot_catcher_times(catcher_df, selected_catcher), error = function(e) empty_plot("Pop time data unavailable")) | |
| p4 <- tryCatch(plot_catcher_throws(catcher_df, selected_catcher), error = function(e) empty_plot("Throwing data unavailable")) | |
| grid.arrange(p1, p2, p3, p4, ncol = 2) | |
| }), | |
| player_scope(), | |
| input$season_catchers, | |
| input$catcher | |
| ) | |
| output$ind_plays_oaa <- bind_app_cache(DT::renderDT({ | |
| req(input$outfielder, input$season_outfield) | |
| outfield_data <- outfield_oaa_season() | |
| tryCatch( | |
| player_fixed_datatable(get_oaa_table(outfield_data, input$outfielder), page_length = 20, filter = "top"), | |
| error = function(e) { | |
| player_fixed_datatable( | |
| defense_error_table(defense_error_message(e)), | |
| page_length = 1, | |
| filter = "none" | |
| ) | |
| } | |
| ) | |
| }), | |
| player_scope(), | |
| input$outfielder, | |
| input$season_outfield | |
| ) | |
| output$star_plot <- bind_app_cache(renderPlot({ | |
| req(input$outfielder, input$season_outfield) | |
| outfield_data <- outfield_oaa_season() | |
| tryCatch( | |
| star_graph(outfield_data, outfield_oaa_all(), input$outfielder), | |
| error = function(e) defense_error_plot(defense_error_message(e)) | |
| ) | |
| }), | |
| player_scope(), | |
| input$outfielder, | |
| input$season_outfield | |
| ) | |
| output$star_table <- bind_app_cache(render_gt({ | |
| req(input$outfielder, input$season_outfield) | |
| outfield_data <- outfield_oaa_season() | |
| tryCatch( | |
| oaa_table(outfield_data, input$outfielder), | |
| error = function(e) gt::gt(defense_error_table(defense_error_message(e))) | |
| ) | |
| }), | |
| player_scope(), | |
| input$outfielder, | |
| input$season_outfield | |
| ) | |
| output$direction <- bind_app_cache(renderPlot({ | |
| req(input$outfielder, input$season_outfield) | |
| outfield_data <- outfield_oaa_season() | |
| tryCatch( | |
| direction_oaa(outfield_data, input$outfielder), | |
| error = function(e) defense_error_plot(defense_error_message(e)) | |
| ) | |
| }), | |
| player_scope(), | |
| input$outfielder, | |
| input$season_outfield | |
| ) | |
| output$all_catches <- bind_app_cache(renderPlotly({ | |
| req(input$outfielder, input$season_outfield) | |
| outfield_data <- outfield_oaa_season() | |
| tryCatch( | |
| show_all_catches(outfield_data, input$outfielder), | |
| error = function(e) defense_error_plotly(defense_error_message(e)) | |
| ) | |
| }), | |
| player_scope(), | |
| input$outfielder, | |
| input$season_outfield | |
| ) | |
| output$star_plot_inf <- bind_app_cache(renderPlot({ | |
| req(input$infielder, input$season_infield) | |
| infield_data <- infield_oaa_season() | |
| tryCatch( | |
| star_graph_inf(infield_data, infield_oaa_all(), input$infielder), | |
| error = function(e) defense_error_plot(defense_error_message(e)) | |
| ) | |
| }), | |
| player_scope(), | |
| input$infielder, | |
| input$season_infield | |
| ) | |
| output$star_table_inf <- bind_app_cache(render_gt({ | |
| req(input$infielder, input$season_infield) | |
| infield_data <- infield_oaa_season() | |
| tryCatch( | |
| oaa_table_inf(infield_data, input$infielder), | |
| error = function(e) gt::gt(defense_error_table(defense_error_message(e))) | |
| ) | |
| }), | |
| player_scope(), | |
| input$infielder, | |
| input$season_infield | |
| ) | |
| output$ind_plays_oaa_inf <- bind_app_cache(DT::renderDT({ | |
| req(input$infielder, input$season_infield) | |
| infield_data <- infield_oaa_season() | |
| tryCatch( | |
| player_fixed_datatable(get_oaa_table_inf(infield_data, input$infielder), page_length = 20, filter = "top"), | |
| error = function(e) { | |
| player_fixed_datatable( | |
| defense_error_table(defense_error_message(e)), | |
| page_length = 1, | |
| filter = "none" | |
| ) | |
| } | |
| ) | |
| }), | |
| player_scope(), | |
| input$infielder, | |
| input$season_infield | |
| ) | |
| output$team_oaa_table <- bind_app_cache(DT::renderDT({ | |
| t <- defense_summary %>% | |
| filter(Name %in% active_team_oaa_names()) %>% | |
| select(-any_of("Team")) %>% | |
| mutate( | |
| succ_rate = round(succ_rate, 2), | |
| x_succ_rate = round(x_succ_rate, 2) | |
| ) %>% | |
| rename(FRV = frv, | |
| OAA = oaa, | |
| `Success Rate` = succ_rate, | |
| `X Success Rate` = x_succ_rate, | |
| Position = position, | |
| Plays = plays, | |
| `Strikes Added` = strikes_added) %>% | |
| select(-any_of("id")) | |
| player_fixed_datatable(t, page_length = 20, filter = "top") | |
| }), | |
| player_scope() | |
| ) | |
| output$glossary_table <- DT::renderDT({ | |
| player_fixed_datatable(glossary_df, page_length = nrow(glossary_df), filter = "none", rownames = FALSE) | |
| }) | |
| observeEvent(input$pens_pitcher, { | |
| req(current_pitcher_selection("pens_pitcher")) | |
| selected_ids <- current_pitcher_ids("pens_pitcher") | |
| available_dates_pens <- bullpens %>% | |
| filter(as.character(PitcherId) %in% selected_ids) %>% | |
| arrange(desc(Date)) %>% | |
| pull(Date) %>% | |
| unique() | |
| updateSelectInput( | |
| session, | |
| "pens_dates", | |
| choices = available_dates_pens, | |
| selected = available_dates_pens[1] | |
| ) | |
| }) | |
| observeEvent(input$pens_dates, { | |
| req(current_pitcher_selection("pens_pitcher"), input$pens_dates) | |
| selected_name <- current_pitcher_name("pens_pitcher") | |
| filtered_pens <- bullpen_selected_data() | |
| output$movement_dates_pen <- bind_app_cache( | |
| renderPlot({ | |
| p1 <- movement(filtered_pens, selected_name, FALSE) | |
| p2 <- release_points(filtered_pens, selected_name) | |
| p3 <- velo(filtered_pens, selected_name) | |
| grid.arrange(p1, p2, p3, ncol = 3) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pens_pitcher"), | |
| input$pens_dates | |
| ) | |
| output$summary_dates_pen <- bind_app_cache( | |
| render_gt({ | |
| pitch_summary_bullpens(filtered_pens, selected_name, 1200) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pens_pitcher"), | |
| input$pens_dates | |
| ) | |
| output$locs_pen <- bind_app_cache( | |
| renderPlot({ | |
| locations_game(filtered_pens, selected_name) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("pens_pitcher"), | |
| input$pens_dates | |
| ) | |
| }) | |
| output$downloadPlot <- downloadHandler( | |
| filename = function() { | |
| player <- gsub(" ", "_", current_pitcher_name("pens_pitcher")) | |
| dates <- gsub("[^0-9]", "", paste(input$pens_dates, collapse = "_")) | |
| paste0(player, "_", dates, ".pdf") | |
| }, | |
| content = function(file) { | |
| pdf(file, width = 11, height = 8.5) | |
| selected_ids <- current_pitcher_ids("pens_pitcher") | |
| selected_name <- current_pitcher_name("pens_pitcher") | |
| filteredpens <- bullpens %>% | |
| filter( | |
| as.character(PitcherId) %in% selected_ids, | |
| Date == input$pens_dates | |
| ) | |
| p1 <- movement(filteredpens, selected_name, FALSE) | |
| p2 <- release_points(filteredpens, selected_name) | |
| p3 <- velo(filteredpens, selected_name) | |
| p4 <- locations_game(filteredpens, selected_name) | |
| tbl <- pitch_summary_bullpens(filteredpens, selected_name, 900) | |
| tmp <- tempfile(fileext = ".png") | |
| gt::gtsave(tbl, tmp, expand = 6) | |
| tbl_img <- png::readPNG(tmp) | |
| tbl_g <- rasterGrob(tbl_img, interpolate = FALSE) | |
| grid.arrange(tbl_g, | |
| arrangeGrob(p1, p2, p3, ncol = 3), | |
| p4, | |
| nrow = 3, | |
| heights = c(1, 2, 2) | |
| ) | |
| dev.off() | |
| } | |
| ) | |
| observeEvent(input$sim_pitcher, { | |
| req(current_pitcher_selection("sim_pitcher")) | |
| selected_ids <- current_pitcher_ids("sim_pitcher") | |
| available_dates_sims <- sim_games %>% | |
| filter(as.character(PitcherId) %in% selected_ids) %>% | |
| mutate(label = as.character(Date)) %>% | |
| arrange(desc(Date)) %>% | |
| pull(label) %>% | |
| unique() | |
| updateSelectizeInput( | |
| session, | |
| "sim_pitcher_dates", | |
| choices = available_dates_sims, | |
| selected = if (length(available_dates_sims)) available_dates_sims[1] else NULL, | |
| server = TRUE | |
| ) | |
| }) | |
| observeEvent(input$sim_pitcher_dates, ignoreInit = FALSE, { | |
| req(current_pitcher_selection("sim_pitcher"), input$sim_pitcher_dates) | |
| selected_name <- current_pitcher_name("sim_pitcher") | |
| filtered_df_sims <- sim_selected_data() | |
| output$sim_movement <- bind_app_cache( | |
| renderPlot({ | |
| p1 <- movement(filtered_df_sims, selected_name, FALSE) | |
| p2 <- release_points(filtered_df_sims, selected_name) | |
| p3 <- velo(filtered_df_sims, selected_name) | |
| grid.arrange(p1, p2, p3, ncol = 3) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("sim_pitcher"), | |
| input$sim_pitcher_dates | |
| ) | |
| output$sim_summary <- bind_app_cache( | |
| render_gt({ | |
| pitch_summary(filtered_df_sims, selected_name, sim = TRUE) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("sim_pitcher"), | |
| input$sim_pitcher_dates | |
| ) | |
| output$locs_sim_l <- bind_app_cache( | |
| renderPlot({ | |
| locations_game(filtered_df_sims, selected_name, "Left") | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("sim_pitcher"), | |
| input$sim_pitcher_dates, | |
| "Left" | |
| ) | |
| output$locs_sim_r <- bind_app_cache( | |
| renderPlot({ | |
| locations_game(filtered_df_sims, selected_name, "Right") | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("sim_pitcher"), | |
| input$sim_pitcher_dates, | |
| "Right" | |
| ) | |
| }) | |
| # ============================================================================= | |
| # Pitch Similarity Tab | |
| # ============================================================================= | |
| # Update seasons and pitch types when pitcher changes | |
| observeEvent(input$similarity_pitcher, { | |
| req(current_pitcher_selection("similarity_pitcher")) | |
| selected_name <- current_pitcher_name("similarity_pitcher") | |
| selected_ids <- current_pitcher_ids("similarity_pitcher") | |
| seasons <- get_pitcher_seasons(selected_ids) | |
| seasons_with_all <- c("All", seasons) | |
| selected_season <- if (length(seasons) > 0) seasons[length(seasons)] else "All" | |
| updateSelectizeInput(session, "similarity_season", | |
| choices = seasons_with_all, | |
| selected = selected_season) | |
| # Also update pitch types directly (don't rely on season change cascade) | |
| season_filter <- if (selected_season == "All") NULL else selected_season | |
| pitch_types <- get_pitcher_pitch_types(selected_ids, season_filter) | |
| updateSelectizeInput(session, "similarity_pitch_type", | |
| choices = pitch_types, | |
| selected = if (length(pitch_types) > 0) pitch_types[1] else NULL) | |
| }) | |
| # Update pitch types when season changes | |
| observeEvent(input$similarity_season, { | |
| req(current_pitcher_selection("similarity_pitcher"), input$similarity_season) | |
| selected_ids <- current_pitcher_ids("similarity_pitcher") | |
| season_filter <- if (input$similarity_season == "All") NULL else input$similarity_season | |
| pitch_types <- get_pitcher_pitch_types(selected_ids, season_filter) | |
| updateSelectizeInput(session, "similarity_pitch_type", | |
| choices = pitch_types, | |
| selected = if (length(pitch_types) > 0) pitch_types[1] else NULL) | |
| }, ignoreInit = TRUE) | |
| # Selected pitcher info table | |
| output$similarity_pitcher_info <- bind_app_cache( | |
| render_gt({ | |
| req(current_pitcher_selection("similarity_pitcher"), input$similarity_pitch_type) | |
| data <- similarity_pitcher_data() | |
| data %>% | |
| dplyr::summarise( | |
| Pitcher = dplyr::first(Pitcher), | |
| `Pitch Type` = dplyr::first(TaggedPitchType), | |
| Season = if (!is.null(input$similarity_season) && input$similarity_season != "All") input$similarity_season else "All", | |
| Pitches = dplyr::n(), | |
| Velo = round(mean(RelSpeed, na.rm = TRUE), 1), | |
| HB = round(mean(HorzBreak, na.rm = TRUE), 1), | |
| IVB = round(mean(InducedVertBreak, na.rm = TRUE), 1), | |
| `Arm Angle` = round(mean(arm_angle, na.rm = TRUE), 1) | |
| ) %>% | |
| gt() %>% | |
| wvu_gt_theme() | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("similarity_pitcher"), | |
| input$similarity_pitch_type, | |
| input$similarity_season | |
| ) | |
| # Similarity results table | |
| output$similarity_table <- bind_app_cache( | |
| DT::renderDT({ | |
| req(current_pitcher_selection("similarity_pitcher"), input$similarity_pitch_type) | |
| season_val <- if (is.null(input$similarity_season) || input$similarity_season == "All") NULL else input$similarity_season | |
| result <- tryCatch({ | |
| if (input$similarity_type == "mlb") { | |
| get_mlb_comparables(current_pitcher_name("similarity_pitcher"), input$similarity_pitch_type, season_val, input$similarity_top_n) | |
| } else { | |
| get_wvu_comparables(current_pitcher_name("similarity_pitcher"), input$similarity_pitch_type, season_val, input$similarity_top_n) | |
| } | |
| }, error = function(e) { | |
| showNotification(paste("Error:", e$message), type = "error") | |
| NULL | |
| }) | |
| req(result) | |
| DT::datatable(result, options = list(pageLength = 15, scrollX = TRUE, dom = 'tip'), rownames = FALSE) | |
| }), | |
| player_scope(), | |
| current_pitcher_selection("similarity_pitcher"), | |
| input$similarity_pitch_type, | |
| input$similarity_season, | |
| input$similarity_type, | |
| input$similarity_top_n | |
| ) | |
| } | |