app.R

library(shiny)
library(bslib)
library(shinyWidgets)
library(ggplot2)
library(MASS)  # For kde2d function
library(viridis)  # For color palette
library(dplyr)  # For data manipulation
library(httr)
library(patchwork)  # For combining plots
library(jsonlite)
library(arrow)

updatedDate <- Sys.Date() - 1

check_patreon_access <- function(email) {
  campaign_id <- Sys.getenv("PATREON_CAMPAIGN_ID")
  access_token <- Sys.getenv("PATREON_ACCESS_TOKEN")
  
  base_url <- paste0("https://www.patreon.com/api/oauth2/v2/campaigns/", campaign_id, "/members")
  
  params <- list(
    `include` = "currently_entitled_tiers",
    `fields[member]` = "patron_status,email",
    `fields[tier]` = "title"
  )
  
  response <- GET(
    base_url,
    query = params,
    add_headers(
      `Authorization` = paste("Bearer", access_token),
      `User-Agent` = "R/httr"
    )
  )
  
  content <- fromJSON(rawToChar(response$content))
  
  # Check in data$attributes for matching email
  matching_row <- which(content$data$attributes$email == email)
  
  if (length(matching_row) > 0) {
    # Get patron status
    patron_status <- content$data$attributes$patron_status[matching_row]
    
    if (patron_status == "active_patron") {
      # Get tier info
      tier_data <- content$data$relationships$currently_entitled_tiers$data[[matching_row]]

      tier_id <- tier_data$id
      
      result <- tier_id %in% c("25062087", "25062090")
      
      return(result)
    }
  }
  
  return(FALSE)
}

download_private_csv <- function(repo_id, filename) {
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename)
  response <- GET(url, add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))))
  
  if (status_code(response) == 200) {
    content <- content(response, "text")
    con <- textConnection(content)
    
    # Try different read options
    data <- read.csv(con, 
                     header = TRUE,
                     check.names = FALSE,  # This prevents R from modifying column names
                     fileEncoding = "UTF-8",
                     stringsAsFactors = FALSE)
    close(con)
    return(data)
  } else {
    stop("Failed to download dataset")
  }
}

heatMap <- function(data, gtitle, concen) {
  custom_colors <- c("#333333","#46363a","#5a383f","#6d3944","#803947","#933948",
                     "#a63848","#b93647","#cb3445","#dd3340","#ee323b","#ff3333")
  
  data_clean <- data %>%
    filter(!is.na(px) & !is.na(pz) & is.finite(px) & is.finite(pz)) 
  
  h_x <- MASS::bandwidth.nrd(data_clean$px)
  h_z <- MASS::bandwidth.nrd(data_clean$pz)
  
  bandwidth_factor <- concen
  
  kde <- kde2d(data_clean$px, data_clean$pz, n = 200, 
               h = c(h_x, h_z) * bandwidth_factor,
               lims = c(-3, 3, 0, 5))
  
  df <- expand.grid(x = kde$x, y = kde$y)
  df$density <- as.vector(kde$z)
  
  ggplot(df, aes(x = x, y = y, z = density)) +
    geom_contour_filled(bins = length(custom_colors) - 1) +
    scale_fill_manual(values = custom_colors) +
    coord_cartesian(xlim = c(-3,3), ylim = c(0,5)) +
    coord_fixed(ratio = 1) +
    labs(title = gtitle) +
    theme_void() +
    geom_segment(aes(x = -0.71, xend = 0.71, y = 1.5, yend = 1.5), colour = "black") +
    geom_segment(aes(x = -0.71, xend = 0.71, y = 3.6, yend = 3.6), colour = "black") +
    geom_segment(aes(x = 0.71, xend = 0.71, y = 1.5, yend = 3.6), colour = "black") +
    geom_segment(aes(x = -0.71, xend = -0.71, y = 1.5, yend = 3.6), colour = "black") +
    theme(
      legend.position = "none",
      plot.background = element_rect(fill = "#333333", color = NA),
      panel.background = element_rect(fill = "#333333", color = NA),
      text = element_text(color = "white"),
      panel.grid = element_blank(),
      plot.title = element_text(hjust = 0.5)
    )
}

download_private_parquet <- function(repo_id, filename) {
  library(httr)
  library(arrow)
  
  # Create the direct download URL based on your example
  url <- paste0("https://huggingface.co/datasets/", repo_id, "/resolve/main/", filename, "?download=true")
  
  # Create a temporary file
  temp_file <- tempfile(fileext = ".parquet")
  
  # Download directly to file
  response <- GET(
    url,
    add_headers(Authorization = paste("Bearer", Sys.getenv("GETCSV"))),
    write_disk(temp_file, overwrite = TRUE)
  )
  
  # Check if download was successful
  if (status_code(response) == 200) {
    tryCatch({
      # Read the parquet file
      data <- read_parquet(temp_file)
      file.remove(temp_file)
      return(data)
    }, error = function(e) {
      file.remove(temp_file)
      stop(paste("Error reading parquet file:", e$message))
    })
  } else {
    file.remove(temp_file)
    stop(paste("Failed to download file. Status code:", status_code(response)))
  }
}

#font_add_google("Roboto Condensed")

is_barrel <- function(df) {
    df$barrel <- with(df, ifelse(hit_angle <= 50 & hit_speed >= 97 & hit_speed * 1.5 - 
                                     hit_angle >= 117 & hit_speed + hit_angle >= 123, 1, 0))
    return(df)
}

apply_percentile_calcs <- function(data) {
  # List of columns to apply percent_rank
  percent_rank_cols <- c("Z-Con%", "Z-Swing%", "O-Con%", "Avg EV", "Max EV", "EV90", "Barrel%", "Swing%", "wOBA",
                         "wOBACON","xwOBA","xDamage")
  
  # List of columns to apply inverse percent_rank
  inverse_percent_rank_cols <- c("Chase%", "Whiff%", "stdev(LA)", "SwStr%")
  
  # Create an empty list to store results
  percentile_list <- list()
  
  # Calculate regular percentiles
  for(col in percent_rank_cols) {
    percentile_list[[col]] <- data.frame(
      `Batter Name` = data[["Batter Name"]],  # Using [[ ]] to preserve exact column name
      `Batter ID` = data[["Batter ID"]],      # Using [[ ]] to preserve exact column name
      metric = col,
      percentile = round(percent_rank(data[[col]]) * 100),
      value = data[[col]],
      stringsAsFactors = FALSE
    )
  }
  
  # Calculate inverse percentiles
  for(col in inverse_percent_rank_cols) {
    percentile_list[[col]] <- data.frame(
      `Batter Name` = data[["Batter Name"]],  # Using [[ ]] to preserve exact column name
      `Batter ID` = data[["Batter ID"]],      # Using [[ ]] to preserve exact column name
      metric = col,
      percentile = round((1 - percent_rank(data[[col]])) * 100),
      value = data[[col]],
      stringsAsFactors = FALSE
    )
  }
  
  # Combine all results into one data frame
  result <- do.call(rbind, percentile_list)
  
  # Reset row names
  rownames(result) <- NULL
  
  return(result)
}

MLB25 <- download_private_parquet("TimStats/StatcastDataAll", "MLB25.parquet")
MLB25$level <- "MLB"
AAA25 <- download_private_parquet("TimStats/StatcastDataAll", "AAA25.parquet")
AAA25$level <- "AAA"
FSL25 <- download_private_parquet("TimStats/StatcastDataAll", "FSL25.parquet")
FSL25$level <- "FSL"

MLB26 <- download_private_parquet("TimStats/StatcastDataAll", "MLB26.parquet")
MLB26$level <- "MLB"
AAA26 <- download_private_parquet("TimStats/StatcastDataAll", "AAA26.parquet")
AAA26$level <- "AAA"
FSL26 <- download_private_parquet("TimStats/StatcastDataAll", "FSL26.parquet")
FSL26$level <- "FSL"

MLB <- download_private_parquet("TimStats/StatcastDataAll", "MLB.parquet")
MLB$level <- "MLB"
AAA <- download_private_parquet("TimStats/StatcastDataAll", "AAA.parquet")
AAA$level <- "AAA"
FSLAll <- download_private_parquet("TimStats/StatcastDataAll", "FSL.parquet")
FSLAll$level <- "FSL"

MLB <- rbind(MLB, MLB25, MLB26)
print("aaa")
AAA <- rbind(AAA, AAA25, AAA26)
print("fsl")
FSL <- rbind(FSLAll, FSL25, FSL26)


ui <- page_fluid(
  theme = bs_theme(bg = "#333333", fg = "#ffffff", primary = "#428bca"),
  uiOutput("page_content")
# card(
#   card_header("2020-2024 Filterable Pitcher Heatmaps"),
#   card(
#     layout_columns(
#       col_widths = c(4, 4, 4),
#       card(
#         selectInput("league", "Select League:", choices = c("MLB","AAA","FSL")),
#         selectInput("player", "Select Player:", choices = c("")),
#         sliderInput("concen", "Heatmap Bandwidth Factor", value = .75, step = 0.05, min = .5, max = 1.5)
#       ),
#       card(
#         selectInput("hand1", "Batter Handedness", choices = c("All Batters","LHH","RHH")),
#         selectInput("pitch1", "Pitch:", choices = c("")),
#         dateRangeInput("date1", "Date Range:", start = "2024-02-09", end = "2024-09-05")
#       ),
#       card(
#         selectInput("hand2", "Batter Handedness", choices = c("All Batters","LHH","RHH")),
#         selectInput("pitch2", "Pitch:", choices = c("")),
#         dateRangeInput("date2", "Date Range:", start = "2024-02-09", end = "2024-09-05")
#       )
#     )
#   ),
#   card(
#     downloadButton("download", "Download Plot", class = "btn-primary mb-3"),
#     plotOutput("combined_graph", height = "600px")
#   )
# )
)

# [Server code remains exactly the same]
server <- function(input, output, session) {
is_authenticated <- reactiveVal(FALSE)
    
    # Render either login page or main app
    output$page_content <- renderUI({
        #if (!is_authenticated()) {
        if (FALSE) {
            # Login page
            card(
                card_header("Authentication Required"),
                card_body(
                    textInput("email", "Enter your Patreon email:"),
                    actionButton("check_access", "Access App", class = "btn-primary"),
                    textOutput("auth_message")
                )
            )
        } else {
            # Main app content (your existing UI)
            card(
                card_header("2020-2024 Filterable Pitcher Heatmaps"),
                card(
                    layout_columns(
                        col_widths = c(4, 4, 4),
                        card(
                            selectInput("league", "Select League:", choices = c("MLB","AAA","FSL")),
                            selectInput("player", "Select Player:", choices = c("")),
                            sliderInput("concen", "Heatmap Bandwidth Factor", value = .75, step = 0.05, min = .5, max = 1.5)
                        ),
                        card(
                            selectInput("hand1", "Batter Handedness", choices = c("All Batters","LHH","RHH")),
                            selectInput("pitch1", "Pitch:", choices = c("")),
                            dateRangeInput("date1", "Date Range:", start = "2026-03-15", end = updatedDate)
                        ),
                        card(
                            selectInput("hand2", "Batter Handedness", choices = c("All Batters","LHH","RHH")),
                            selectInput("pitch2", "Pitch:", choices = c("")),
                            dateRangeInput("date2", "Date Range:", start = "2026-03-15", end = updatedDate)
                        )
                    )
                ),
                card(
                    downloadButton("download", "Download Plot", class = "btn-primary mb-3"),
                    plotOutput("combined_graph", height = "600px")
                )
            )
        }
    })
    
    # Handle authentication
    observeEvent(input$check_access, {
        
        if (check_patreon_access(input$email)) {
            is_authenticated(TRUE)
        } else {
            output$auth_message <- renderText({
                "Access denied. Please ensure you are an active Veteran or Hall of Fame tier patron."
            })
        }
    })
  
  pname <- reactiveVal()
  
  plot_data <- reactive({
    t <- pname()
    
    # Function to filter data based on inputs
    filter_data <- function(hand, pitch, date_range) {
      data <- if(hand == "All Batters") {
        t %>% filter(`Pitcher Name` == input$player)
      } else if(hand == "LHH") {
        t %>% filter(bside == "L", `Pitcher Name` == input$player)
      } else {
        t %>% filter(bside == "R", `Pitcher Name` == input$player)
      }
      
      data %>%
        filter(pitch_name == pitch) %>%
        filter(between(as.Date(date), date_range[1], date_range[2]))
    }
    
    graph1_data <- filter_data(input$hand1, input$pitch1, input$date1)
    graph2_data <- filter_data(input$hand2, input$pitch2, input$date2)
    
    title1 <- paste0(input$player, " ", input$pitch1, " vs. ", input$hand1, "\n", input$date1[1], " to ", input$date1[2])
    title2 <- paste0(input$player, " ", input$pitch2, " vs. ", input$hand2, "\n", input$date2[1], " to ", input$date2[2])
    
    plot1 <- heatMap(graph1_data, title1, input$concen)
    plot2 <- heatMap(graph2_data, title2, input$concen)
    
    plot1 + plot2 + 
      plot_layout(ncol = 2) +
      plot_annotation(
        title = paste0(input$player, " Pitch Comparison"),
        theme = theme(
          plot.title = element_text(hjust = 0.5, size = 20, color = "white"),
          plot.background = element_rect(fill = "#333333", color = NA),
          plot.margin = margin(0, 0, 0, 0)
        )
      ) &
      theme(plot.margin = margin(0, 0, 0, 0))
  })
  
  observeEvent(input$league, {
    req(input$league)
    tryCatch({
      if(input$league == "MLB"){
        t <- mlb
      } else if(input$league == "AAA"){
        t <- aaa
      } else if(input$league == "FSL"){
        t <- fsl
      }
      pname(t)
      updateSelectInput(
        session = session,
        inputId = "player", 
        label = "Select Player:", 
        choices = unique(t$`Pitcher Name`),
        selected = NULL
      )
    }, error = function(e) {
      message("Error downloading or processing data: ", e$message)
    })
  })
  
  observeEvent(input$player, {
    req(input$player)
    tryCatch({
      t <- pname()
      d <- t |>
        filter(`Pitcher Name` == input$player)
      updateSelectInput(
        session = session,
        inputId = "pitch1", 
        label = "Pitch:", 
        choices = unique(d$`pitch_name`),
        selected = NULL
      )
      updateSelectInput(
        session = session,
        inputId = "pitch2", 
        label = "Pitch:", 
        choices = unique(d$`pitch_name`),
        selected = NULL
      )
    }, error = function(e) {
      message("Error processing player data: ", e$message)
    })
  })
  
  output$combined_graph <- renderPlot({
    plot_data()
  }, bg = "#333333", width = 800)
  
  output$download <- downloadHandler(
    filename = function() {
      paste0(input$player, "_pitch_comparison.png")
    },
    content = function(file) {
      ggsave(file, plot = plot_data(), width = 12, height = 8, dpi = 300)
    }
  )
}

shinyApp(ui = ui, server = server)