Spaces:

TimStats
/

Heatmaps

Sleeping

Update app.R

065500e verified 6 months ago

14.5 kB

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)

	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)