Spaces:
Sleeping
Sleeping
| #QUEENS PICTH DESIGN APP API | |
| library(plumber) | |
| library(mgcv) | |
| library(data.table) | |
| library(jsonlite) | |
| cat("Loading model artifacts...\n") | |
| fit <- readRDS("fit_l6_champ.rds") | |
| vaa_mod <- readRDS("vaa_anchor_model.rds") | |
| haa_mod <- readRDS("haa_anchor_model.rds") | |
| scaling <- readRDS("shape_scaling_factors.rds") | |
| mu_l6 <- scaling$mu_l6 | |
| sig_l6 <- scaling$sig_l6 | |
| train_means <- fread("train_means.csv") | |
| model_levels <- c("FF","CU","ST","SI","FC","SL","CH","FS","KC","SV","KN","EP","FA","FO","CS","SC") | |
| cat(sprintf("Model ready. %d pitch types loaded.\n", length(model_levels))) | |
| cat("Loading pitcher profiles...\n") | |
| pitcher_profiles <- tryCatch({ | |
| dt <- fread("pitcher_profiles.csv") | |
| cat(sprintf("Pitcher profiles loaded: %d rows, %d pitchers.\n", | |
| nrow(dt), dt[, uniqueN(player_name)])) | |
| dt | |
| }, error = function(e) { | |
| warning(sprintf("Failed to load pitcher_profiles.csv: %s", conditionMessage(e))) | |
| NULL | |
| }) | |
| build_features <- function(d) { | |
| d <- as.data.table(d) | |
| d[, p_throws := fifelse(p_throws %in% c("Left","LHP"), "L", | |
| fifelse(p_throws %in% c("Right","RHP"), "R", p_throws))] | |
| d[, pfx_x_sym := fifelse(p_throws == "L", pfx_x * -1, pfx_x)] | |
| d[, plate_x_sym := fifelse(p_throws == "L", plate_x * -1, plate_x)] | |
| d[, rel_x_sym := fifelse(p_throws == "L", release_pos_x * -1, release_pos_x)] | |
| if (!"release_extension" %in% names(d)) d[, release_extension := 6.0] | |
| d[is.na(release_extension), release_extension := 6.0] | |
| d[, flight_time := (1.4167 - 50) / vy0] | |
| d[, vaa := atan((vz0 + az * flight_time) / -(vy0 + ay * flight_time)) * (180 / pi)] | |
| d[, haa := atan((vx0 + ax * flight_time) / -(vy0 + ay * flight_time)) * (180 / pi)] | |
| d[, haa_sym := fifelse(p_throws == "L", haa * -1, haa)] | |
| d[, vaa_resid := vaa - predict(vaa_mod, newdata = d)] | |
| d[, haa_resid_sym := haa_sym - predict(haa_mod, newdata = d)] | |
| d <- merge(d, train_means, by = "pitch_type", all.x = FALSE) | |
| d[, ivb_diff := pfx_z - base_ivb] | |
| d[, hb_diff_sym := pfx_x_sym - base_hb] | |
| d[, pitch_type := factor(as.character(pitch_type), levels = model_levels)] | |
| d[, p_throws := factor(as.character(p_throws), levels = c("L", "R"))] | |
| d[!is.na(pitch_type)] | |
| } | |
| score_pitches <- function(d) { | |
| d <- build_features(d) | |
| if (nrow(d) == 0) return(list(error = "No valid pitches after feature engineering")) | |
| raw <- predict(fit, newdata = d) | |
| shape_plus <- (((raw * -1) - mu_l6) / sig_l6) * 10 + 100 | |
| term_mat <- predict(fit, newdata = d, type = "terms") | |
| col_names <- colnames(term_mat) | |
| list( | |
| n = nrow(d), | |
| shape_plus = round(as.numeric(shape_plus), 1), | |
| terms = lapply(seq_len(nrow(d)), function(i) { | |
| row <- as.list(round(term_mat[i, ], 3)) | |
| names(row) <- col_names | |
| row | |
| }) | |
| ) | |
| } | |
| #* @apiTitle Queens Shape+ API | |
| #* @apiDescription Scores pitch shapes using the Shape+ v2.0 GAM model | |
| #* @filter cors | |
| function(req, res) { | |
| res$setHeader("Access-Control-Allow-Origin", "*") | |
| res$setHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") | |
| res$setHeader("Access-Control-Allow-Headers", "Content-Type") | |
| if (req$REQUEST_METHOD == "OPTIONS") { | |
| res$status <- 200 | |
| return(list()) | |
| } | |
| plumber::forward() | |
| } | |
| #* @post /score | |
| #* @serializer json | |
| function(req) { | |
| tryCatch({ | |
| body <- fromJSON(req$postBody, simplifyDataFrame = TRUE) | |
| score_pitches(as.data.table(body)) | |
| }, error = function(e) { | |
| list(error = conditionMessage(e)) | |
| }) | |
| } | |
| #* Find comparable pitchers by movement profile | |
| #* Expects JSON body: pitch_type, ivb, hb_sym, velo, arm_angle, p_throws | |
| #* Returns top 5 closest pitchers with their full arsenals | |
| #* @post /find_comps | |
| #* @serializer unboxedJSON | |
| function(req) { | |
| tryCatch({ | |
| # ── Guard: profiles must have loaded at startup ────────────────────────── | |
| if (is.null(pitcher_profiles)) { | |
| return(list(error = "pitcher_profiles.csv failed to load at startup")) | |
| } | |
| # ── Parse request body ─────────────────────────────────────────────────── | |
| body <- fromJSON(req$postBody, simplifyVector = TRUE) | |
| input_pitch_type <- as.character(body$pitch_type) | |
| input_p_throws <- as.character(body$p_throws) | |
| input_ivb <- as.numeric(body$ivb) | |
| input_hb <- as.numeric(body$hb_sym) | |
| input_velo <- as.numeric(body$velo) | |
| input_arm <- as.numeric(body$arm_angle) | |
| # ── Filter to matching anchor pitch type (any handedness — hb_sym is already symmetrized) | |
| anchor_rows <- pitcher_profiles[pitch_type == input_pitch_type] | |
| if (nrow(anchor_rows) == 0) { | |
| return(list(error = "no matches")) | |
| } | |
| # ── Compute weighted distance for each matching row ────────────────────── | |
| # Arm angle tightly weighted (/8) so a submarine pitcher never matches an over-the-top guy. | |
| # If input arm_angle is NA/null, skip that term to avoid NaN distances. | |
| arm_term <- if (!is.na(input_arm)) ((anchor_rows$arm_angle - input_arm) / 8)^2 else 0 | |
| anchor_rows[, dist := sqrt( | |
| ((ivb - input_ivb) / 3)^2 + | |
| ((hb_sym - input_hb) / 3)^2 + | |
| ((velo - input_velo) / 5)^2 + | |
| arm_term | |
| )] | |
| # ── Top 5 closest pitchers ─────────────────────────────────────────────── | |
| top5 <- head(anchor_rows[order(dist)], 5) | |
| # ── For each top pitcher, pull their full arsenal ──────────────────────── | |
| result <- lapply(seq_len(nrow(top5)), function(i) { | |
| row <- top5[i] | |
| pitcher_nm <- row$player_name | |
| anchor_dist <- round(row$dist, 3) | |
| arsenal_rows <- pitcher_profiles[player_name == pitcher_nm] | |
| arsenal <- lapply(seq_len(nrow(arsenal_rows)), function(j) { | |
| r <- arsenal_rows[j] | |
| list( | |
| pitch_type = r$pitch_type, | |
| velo = r$velo, | |
| ivb = r$ivb, | |
| hb_sym = r$hb_sym, | |
| rel_z = r$rel_z, | |
| arm_angle = r$arm_angle, | |
| n = r$n | |
| ) | |
| }) | |
| list( | |
| player_name = pitcher_nm, | |
| p_throws = row$p_throws, | |
| anchor_dist = anchor_dist, | |
| arsenal = arsenal | |
| ) | |
| }) | |
| result | |
| }, error = function(e) { | |
| list(error = conditionMessage(e)) | |
| }) | |
| } | |
| #* Health check | |
| #* @get /health | |
| function() { | |
| list(status = "ok", model = "fit_l6_champ", time = as.character(Sys.time())) | |
| } | |