Update app.R

app.R

@@ -134,7 +134,7 @@ download_private_rds <- function(repo_id, filename, max_retries = 3) {
         tmp <- tempfile(fileext = ".rds")
         writeBin(content(response, "raw"), tmp)
         return(readRDS(tmp))
-      } else warning(paste("Attempt", attempt, "failed with status:", status_code(response)))
+      } else warning(paste("Attempt", attempt, "failed:", e$message))
     }, error = function(e) {
       warning(paste("Attempt", attempt, "failed:", e$message))
       if (attempt < max_retries) Sys.sleep(2)
@@ -393,6 +393,26 @@ IF_OAA_26 <- if_oaa_setup(pbp_pos_ncaa_spring26)
 # Defensive positioning data
 def_pos_data <- pbp_pos_ncaa_spring26
 
+# ============================================================
+# LOAD BASERUNNING HUSTLE DATA
+# ============================================================
+baserunning_raw <- read.csv("Coastal_Carolina_Baseball_Hustle__2025_Sheet1_.csv",
+                            stringsAsFactors = FALSE)
+
+baserunning <- baserunning_raw %>%
+  mutate(across(where(is.character), str_trim)) %>%
+  mutate(
+    MaxSpeed  = as.numeric(str_remove(Max.Sprint.Speed, " MPH")),
+    AvgSpeed  = as.numeric(str_remove(Average.Sprint.Speed, " MPH")),
+    HustlePct = as.numeric(str_remove(Hustle.., "%")),
+    Speed75   = as.numeric(str_remove(X75..Hustle..Speed, " MPH")),
+    Speed80   = as.numeric(str_remove(X80..Hustle..Speed, " MPH")),
+    Speed90   = as.numeric(str_remove(X90..Hustle..Speed, " MPH")),
+    NoHR_Flyout = as.numeric(str_remove(No.Home.Runs.Flyouts., "%"))
+  ) %>%
+  dplyr::select(Player, MaxSpeed, AvgSpeed, HustlePct, Speed75, Speed80, Speed90, NoHR_Flyout) %>%
+  filter(!is.na(Player) & Player != "")
+
 # ============================================================
 # FIELD DRAWING HELPERS
 # ============================================================
@@ -580,7 +600,6 @@ direction_oaa <- function(player, position, oaa_data) {
                          radar_data[1, dir_levels])
   rownames(player_matrix) <- c("max","min",player)
   
-  # Return the data for rendering in renderPlot
   list(player_matrix = player_matrix, axis_labels = axis_labels,
        player = player, position = position, table = tbl)
 }
@@ -886,9 +905,42 @@ app_ui <- fluidPage(
     tabPanel("6th Tool Fielding", h4("Coming Soon", style="text-align:center;color:darkcyan;padding:60px;")),
     
     # =============================================
-    # TAB 7: Baserunning (placeholder)
+    # TAB 7: Baserunning
     # =============================================
-    tabPanel("Baserunning", h4("Coming Soon", style="text-align:center;color:darkcyan;padding:60px;")),
+    tabPanel("Baserunning",
+      fluidRow(
+        column(3,
+          selectInput("br_player", "Player:", choices = NULL)),
+        column(3,
+          selectInput("br_metric", "Rank By:",
+            choices = c("Hustle %" = "HustlePct",
+                        "Max Sprint Speed" = "MaxSpeed",
+                        "Avg Sprint Speed" = "AvgSpeed",
+                        "No HR/Flyout %" = "NoHR_Flyout"),
+            selected = "HustlePct"))
+      ),
+      hr(),
+      h4("Team Hustle Leaderboard", class = "section-header"),
+      gt_output("br_leaderboard"),
+      hr(),
+      fluidRow(
+        column(6,
+          h4("Sprint Speed Comparison", class = "section-header"),
+          plotlyOutput("br_speed_chart", height = "420px")),
+        column(6,
+          h4("Hustle % Rankings", class = "section-header"),
+          plotlyOutput("br_hustle_chart", height = "420px"))
+      ),
+      hr(),
+      fluidRow(
+        column(6,
+          h4("Player Speed Profile (Team Percentiles)", class = "section-header"),
+          plotOutput("br_radar", height = "420px")),
+        column(6,
+          h4("Hustle Threshold Breakdown", class = "section-header"),
+          plotlyOutput("br_threshold_chart", height = "420px"))
+      )
+    ),
     
     # =============================================
     # TAB 8: Team Defensive Positioning
@@ -916,7 +968,7 @@ app_ui <- fluidPage(
     ),
     
     # =============================================
-    # TAB 9: OAA Leaderboard (placeholder)
+    # TAB 9: OAA Leaderboard
     # =============================================
     tabPanel("OAA Leaderboard",
       fluidRow(
@@ -1044,7 +1096,6 @@ server <- function(input, output, session) {
   # OUTFIELD OAA OUTPUTS
   # ============================================================
   
-  # Star graph
   output$of_star_graph <- renderPlotly({
     req(input$of_player, input$of_position)
     d <- of_data()
@@ -1052,7 +1103,6 @@ server <- function(input, output, session) {
     star_graph(input$of_player, pos, d)
   })
   
-  # Field graph
   of_field_result <- reactive({
     req(input$of_player, input$of_position)
     d <- of_data()
@@ -1068,7 +1118,6 @@ server <- function(input, output, session) {
     of_field_result()[[2]]
   })
   
-  # Direction OAA
   of_direction_result <- reactive({
     req(input$of_player, input$of_position)
     d <- of_data()
@@ -1097,7 +1146,6 @@ server <- function(input, output, session) {
   # INFIELD OAA OUTPUTS
   # ============================================================
   
-  # Star graph
   output$if_star_graph <- renderPlotly({
     req(input$if_player, input$if_position)
     d <- if_data()
@@ -1105,7 +1153,6 @@ server <- function(input, output, session) {
     infield_star_graph(input$if_player, pos, d)
   })
   
-  # Field graph
   if_field_result <- reactive({
     req(input$if_player, input$if_position)
     d <- if_data()
@@ -1207,6 +1254,204 @@ server <- function(input, output, session) {
       tab_style(style = cell_text(color = "white"),
                 locations = cells_title(groups = "title"))
   })
+
+  # ============================================================
+  # BASERUNNING TAB
+  # ============================================================
+  
+  # Populate player dropdown
+  observeEvent(authed(), {
+    req(isTRUE(authed()))
+    updateSelectInput(session, "br_player",
+                      choices = sort(baserunning$Player),
+                      selected = baserunning$Player[1])
+  }, ignoreInit = TRUE)
+  
+  # ---------- Hustle Leaderboard GT Table ----------
+  output$br_leaderboard <- render_gt({
+    req(isTRUE(authed()), input$br_metric)
+    
+    baserunning %>%
+      arrange(desc(.data[[input$br_metric]])) %>%
+      mutate(Rank = row_number()) %>%
+      dplyr::select(Rank, Player,
+                    `Max Speed (MPH)` = MaxSpeed,
+                    `Avg Speed (MPH)` = AvgSpeed,
+                    `Hustle %` = HustlePct,
+                    `75% Threshold` = Speed75,
+                    `80% Threshold` = Speed80,
+                    `90% Threshold` = Speed90,
+                    `No HR/Flyout %` = NoHR_Flyout) %>%
+      gt() %>%
+      gt_theme_guardian() %>%
+      tab_header(title = "Baserunning Hustle Leaderboard") %>%
+      fmt_number(columns = c(`Max Speed (MPH)`, `Avg Speed (MPH)`,
+                             `75% Threshold`, `80% Threshold`, `90% Threshold`),
+                 decimals = 2) %>%
+      fmt_number(columns = c(`Hustle %`, `No HR/Flyout %`), decimals = 2) %>%
+      cols_align(align = "center", columns = everything()) %>%
+      cols_align(align = "left", columns = Player) %>%
+      data_color(columns = `Hustle %`,
+                 palette = c("white", "#008b8b"), domain = c(80, 95)) %>%
+      data_color(columns = `Max Speed (MPH)`,
+                 palette = c("white", "#cd853f"), domain = c(18, 21)) %>%
+      data_color(columns = `No HR/Flyout %`,
+                 palette = c("white", "#008b8b"), domain = c(85, 100)) %>%
+      data_color(columns = `Avg Speed (MPH)`,
+                 palette = c("white", "#20b2aa"), domain = c(15, 19)) %>%
+      tab_options(
+        heading.background.color = "darkcyan",
+        column_labels.background.color = "darkcyan",
+        table.border.top.color = "peru",
+        table.border.bottom.color = "peru") %>%
+      tab_style(style = cell_text(color = "white"),
+                locations = cells_title(groups = "title"))
+  })
+  
+  # ---------- Sprint Speed Grouped Bar Chart ----------
+  output$br_speed_chart <- renderPlotly({
+    req(isTRUE(authed()))
+    
+    d <- baserunning %>%
+      arrange(desc(MaxSpeed)) %>%
+      mutate(Player = factor(Player, levels = rev(Player))) %>%
+      pivot_longer(cols = c(MaxSpeed, AvgSpeed),
+                   names_to = "Type", values_to = "Speed") %>%
+      mutate(Type = ifelse(Type == "MaxSpeed",
+                           "Max Sprint Speed", "Avg Sprint Speed"))
+    
+    p <- ggplot(d, aes(x = Player, y = Speed, fill = Type)) +
+      geom_col(position = position_dodge(width = 0.7),
+               width = 0.6, color = "black", size = 0.3) +
+      scale_fill_manual(values = c("Max Sprint Speed" = "darkcyan",
+                                   "Avg Sprint Speed" = "peru")) +
+      coord_flip() +
+      labs(x = NULL, y = "Speed (MPH)", fill = NULL) +
+      theme_minimal() +
+      theme(legend.position = "top",
+            panel.grid.major.y = element_blank(),
+            plot.background = element_rect(fill = "transparent", color = NA))
+    
+    ggplotly(p, tooltip = c("y", "fill")) %>%
+      layout(legend = list(orientation = "h", x = 0.15, y = 1.08))
+  })
+  
+  # ---------- Hustle % Lollipop Chart ----------
+  output$br_hustle_chart <- renderPlotly({
+    req(isTRUE(authed()))
+    
+    d <- baserunning %>%
+      arrange(HustlePct) %>%
+      mutate(Player = factor(Player, levels = Player))
+    
+    p <- ggplot(d, aes(x = Player, y = HustlePct)) +
+      geom_segment(aes(xend = Player, y = 75, yend = HustlePct),
+                   color = "darkcyan", size = 1.2) +
+      geom_point(size = 4, color = "peru") +
+      geom_text(aes(label = paste0(round(HustlePct, 1), "%")),
+                hjust = -0.3, size = 3, color = "darkcyan", fontface = "bold") +
+      coord_flip() +
+      scale_y_continuous(limits = c(75, 100),
+                         labels = function(x) paste0(x, "%")) +
+      labs(x = NULL, y = "Hustle %") +
+      theme_minimal() +
+      theme(panel.grid.major.y = element_blank(),
+            plot.background = element_rect(fill = "transparent", color = NA))
+    
+    ggplotly(p, tooltip = c("y")) %>%
+      layout(showlegend = FALSE)
+  })
+  
+  # ---------- Player Speed Radar Chart ----------
+  output$br_radar <- renderPlot({
+    req(isTRUE(authed()), input$br_player)
+    
+    # Percentile-rank each metric within the team
+    pct_data <- baserunning %>%
+      mutate(across(c(MaxSpeed, AvgSpeed, HustlePct, Speed75,
+                      Speed80, Speed90, NoHR_Flyout),
+                    ~ percent_rank(.) * 100,
+                    .names = "pct_{.col}"))
+    
+    player_row <- pct_data %>% filter(Player == input$br_player)
+    if (nrow(player_row) == 0) return(NULL)
+    
+    radar_cols <- c("pct_MaxSpeed", "pct_AvgSpeed", "pct_HustlePct",
+                    "pct_Speed75", "pct_Speed80", "pct_Speed90", "pct_NoHR_Flyout")
+    labels <- c("Max Speed", "Avg Speed", "Hustle %",
+                "75% Threshold", "80% Threshold", "90% Threshold", "No HR/Flyout %")
+    
+    radar_matrix <- rbind(
+      max = rep(100, length(radar_cols)),
+      min = rep(0, length(radar_cols)),
+      player_row[, radar_cols]
+    )
+    colnames(radar_matrix) <- labels
+    
+    par(mar = c(1, 2, 3, 2))
+    radarchart(as.data.frame(radar_matrix),
+               axistype = 1,
+               pcol = "darkcyan",
+               pfcol = scales::alpha("darkcyan", 0.3),
+               plwd = 3, plty = 1,
+               cglcol = "grey75", cglty = 1, cglwd = 0.8,
+               vlcex = 0.85, seg = 4,
+               caxislabels = c("0th", "25th", "50th", "75th", "100th"))
+    title(paste0(input$br_player, " \u2014 Speed & Hustle Profile"),
+          cex.main = 1.3, col.main = "darkcyan")
+  })
+  
+  # ---------- Hustle Threshold Stacked Bar Chart ----------
+  output$br_threshold_chart <- renderPlotly({
+    req(isTRUE(authed()), input$br_player)
+    
+    d <- baserunning %>%
+      filter(Player == input$br_player) %>%
+      pivot_longer(cols = c(Speed75, Speed80, Speed90),
+                   names_to = "Threshold", values_to = "Speed") %>%
+      mutate(Threshold = case_when(
+        Threshold == "Speed75" ~ "75% Hustle",
+        Threshold == "Speed80" ~ "80% Hustle",
+        Threshold == "Speed90" ~ "90% Hustle"),
+        Threshold = factor(Threshold, levels = c("75% Hustle", "80% Hustle", "90% Hustle")))
+    
+    # Add team avg for comparison
+    team_avg <- baserunning %>%
+      summarize(Speed75 = mean(Speed75, na.rm = TRUE),
+                Speed80 = mean(Speed80, na.rm = TRUE),
+                Speed90 = mean(Speed90, na.rm = TRUE)) %>%
+      pivot_longer(cols = everything(),
+                   names_to = "Threshold", values_to = "TeamAvg") %>%
+      mutate(Threshold = case_when(
+        Threshold == "Speed75" ~ "75% Hustle",
+        Threshold == "Speed80" ~ "80% Hustle",
+        Threshold == "Speed90" ~ "90% Hustle"),
+        Threshold = factor(Threshold, levels = c("75% Hustle", "80% Hustle", "90% Hustle")))
+    
+    d <- left_join(d, team_avg, by = "Threshold")
+    
+    p <- ggplot(d, aes(x = Threshold)) +
+      geom_col(aes(y = Speed, fill = "Player"),
+               width = 0.5, color = "black", size = 0.3) +
+      geom_point(aes(y = TeamAvg, color = "Team Avg"),
+                 size = 5, shape = 18) +
+      geom_text(aes(y = Speed, label = paste0(round(Speed, 2), " MPH")),
+                vjust = -0.5, size = 3.5, fontface = "bold", color = "darkcyan") +
+      scale_fill_manual(values = c("Player" = "darkcyan"), name = NULL) +
+      scale_color_manual(values = c("Team Avg" = "peru"), name = NULL) +
+      scale_y_continuous(limits = c(0, max(baserunning$Speed90, na.rm = TRUE) + 2),
+                         labels = function(x) paste0(x, " MPH")) +
+      labs(x = NULL, y = "Speed (MPH)",
+           title = paste0(input$br_player, " vs. Team Average")) +
+      theme_minimal() +
+      theme(legend.position = "top",
+            plot.title = element_text(hjust = 0.5, color = "darkcyan", face = "bold"),
+            panel.grid.major.x = element_blank(),
+            plot.background = element_rect(fill = "transparent", color = NA))
+    
+    ggplotly(p, tooltip = c("y")) %>%
+      layout(legend = list(orientation = "h", x = 0.25, y = 1.08))
+  })
 }
 
 shinyApp(ui, server)