Release Point Heat Maps

##################################
# Release_Point_Heat_Home_Away.r #
##################################

# This program plots a series of heat maps of the data at a number of
# distances in the range of a pitcher's release point.
# These images are saved as jpeg's and can be converted into a GIF.

# Written by Matthew Mata, May 2015 (matthewrmata@gmail.com)

#############
# LIBRARIES #
#############

# This library calls MySQL
library('RODBC');
library('calibrate');
library('diagram');
library('fields');

#############
# FUNCTIONS #
#############

# This function creates a heat map a various distances for the release point
heat_track <- function(Pitch,FIRST,LAST,YEAR,H_or_A){
    x0 <- Pitch$x0;
    y0 <- Pitch$y0;
    z0 <- Pitch$z0;
    vx0 <- Pitch$vx0;
    vy0 <- Pitch$vy0;
    vz0 <- Pitch$vz0;
    ax <- Pitch$ax;
    ay <- Pitch$ay;
    az <- Pitch$az;
    N_p <- length(x0);
    # Define the function with compact support
    Patch <- array(0,c(50,50));
    dx <- 0.005;
    for (i in 1:50){
        x <- dx*(i-0.5) - 0.125;
        for (j in 1:50){
            y <- dx*(j-0.5) - 0.125;
            r <- sqrt(x**2 + y**2);
            if (r <= 0.125){
                Patch[i,j] <- 1.0;
            }
            else {
                Patch[i,j] <- 0;
            }
        }
    }
    # Set the number of increments
    N_y <- 30;
    # Initialize the arrays for storing the data at different distances
    R_x <- array(0,dim=c(N_y,N_p));
    R_y <- array(0,dim=c(N_y,N_p));
    R_z <- array(0,dim=c(N_y,N_p));
    # Set the interval of where the release point will occur
    D_y <- seq(50,179/3,length=N_y);
    a <- 0.5*ay;
    b <- vy0;
    # Loop over the distances
    for (i in 1:N_y){
        # Set the coefficients for use in the Pythagorean theorem to solve a t^2 + b t + c = (Distance in y) for t
        c <- y0 - D_y[i];
        t <- (-b - sqrt(b^2 - 4*a*c))/(2*a);
        # Evaluate the distance at t
        R_x[i,] <- t(0.5*ax*t^2 + vx0*t + x0);
        R_y[i,] <- t(0.5*ay*t^2 + vy0*t + y0);
        R_z[i,] <- t(0.5*az*t^2 + vz0*t + z0);
    }
    # Set bounds for the plot (adjusted to two decimal places)
    min_x <- floor(100*min(c(R_x)))/100 - 0.25;
    max_x <- ceiling(100*max(c(R_x)))/100 + 0.25;
    min_z <- floor(100*min(c(R_z)))/100 - 0.25;
    max_z <- ceiling(100*max(c(R_z)))/100 + 0.25;
    L_x <- round((max_x - min_x)/0.005,digits=0) + 1;
    L_z <- round((max_z - min_z)/0.005,digits=0) + 1;
    X <- seq(min_x+dx/2,max_x-dx/2,length=L_x);
    Y <- seq(min_z-dx/2,max_z-dx/2,length=L_z);
    Heat_Array <- array(0,dim=c(L_x,L_z));
    for (i in 1:N_y){
        # Set the file name
        if (i < 10){
            filename <- paste(LAST,"_",YEAR,"_RP_",H_or_A,"_0",i,".jpg",sep="");
        }
        else {
            filename <- paste(LAST,"_",YEAR,"_RP_",H_or_A,"_",i,".jpg",sep="");
        }
        jpeg(filename);
        # Zero out the array
        Heat_Array <- 0*Heat_Array;
        # Construct the heat map
        for (j in 1:N_p){
            x_ind <- floor((R_x[i,j]-min_x)/dx) + 1;
            y_ind <- floor((R_z[i,j]-min_z)/dx) + 1;
            x_patch_range <- seq(x_ind-24,x_ind+25,length = 50);
            y_patch_range <- seq(y_ind-24,y_ind+25,length = 50);
            Heat_Array[x_patch_range,y_patch_range] <- Heat_Array[x_patch_range,y_patch_range] + Patch;
        }
        Heat_Array <- Heat_Array/max(c(Heat_Array));
        # Plot
        image.plot(X,Y,Heat_Array,xlim=c(min_x,max_x),ylim =c(min_z,max_z), col = tim.colors(64), zlim=c(0,1),
                xlab='Horizontal Location (Feet)',ylab='Vertical Location (Feet)',
                main=paste(FIRST," ",LAST," 20",YEAR," (",H_or_A,") at ",round(D_y[i],digits=2)," Ft",sep=""));
        dev.off();
    }
}

########
# MAIN #
########

# Set the player name (PARAMETER)
FIRST <- 'Felix';
LAST <- 'Hernandez';
YEAR <- 14;

DB <- paste("MLB20",YEAR,sep="");

# Set HA to "1" for Home and "2" for Away data
HA <- 1;

if (HA == 1) {H_or_A <- 'H'} else {H_or_A <- 'A'};

print(paste("Pitcher: ",FIRST," ",LAST,", 20",YEAR," (",H_or_A,")",sep=""));

# Set the channel
channel <- odbcConnect(DB);

# Set the query to get the PITCHf/x data and exclude any missing entries (by finding entries missing the px value)
# Also exclude intentional balls
Release_Query = paste("SELECT x0, y0, z0, vx0, vy0, vz0, ax, ay, az FROM pitches WHERE
                       ab_id IN (SELECT ab_id FROM atbats WHERE
                       pitcher = (SELECT eliasid FROM players WHERE first = '",
                       FIRST,"' AND last = '",LAST,"') AND half = ",HA,") AND
                       pitch_type <> 'IN' AND px IS NOT NULL",sep="");

# Download the pitch data
Release <- sqlQuery(channel,Release_Query);

# Close the channel
close(channel);

heat_track(Release,FIRST,LAST,YEAR,H_or_A);