Factors Influence NFL Field Goals

1 Introduction

1.0.1 Description

In this data set we have data from the 2008 NFL season. More specifically we have factors that go into NFL fielgoals. Some variables include the kicking team, Name, Distance, timerem, defscore, and GOOD.

Kickteam - Name of the kicking team Name - Name of the kicker Distance - How far the ball is from the goal Timerem - How much time is on the game clock remaining in the game Kickdiff - the level of difficulty of the kick Defscore- The score of the opposing team GOOD - If the field goal is made or not, a 1 for a make and 0 for a miss

1.0.2 Question

The objective of this analysis is to build a logistic regression model to predict a made field goal using diffrent factors tat go into a make.

1.0.3 Data Cleaning

fieldgoals <- read.csv("https://raw.githubusercontent.com/TylerBattaglini/STA-321/refs/heads/main/nfl2008_fga.csv", header = TRUE)

clean_fieldgoals <- na.omit(fieldgoals)
clean_fieldgoals <- clean_fieldgoals %>% select(-GameDate, -AwayTeam, -HomeTeam, -qtr, -min, -sec, -def, -down, -togo, -kicker, -ydline, -homekick, -offscore, -season, -Missed, -Blocked, -kickteam, -name)

head(clean_fieldgoals)

  distance kickdiff timerem defscore GOOD
1       30       -3    2822        3    1
2       46        0    3287        0    1
3       28        7    2720        0    1
4       37       14    2742        0    1
5       39        0    3056        0    1
6       40       -3    3043        3    1

We take out any observations with a missing value. We also take out many variables due to there being a high likeleyhood for multicollineairty. We already have a variable for time so we eliminated many variables related to time. We also already have a variable for a make so we do not need any for a miss or blocked, that would just be a repeat our data. The others are just categorical variables that are to identify the kicker or kicking team which again we already have variables that describe that.

library(psych)
pairs.panels(clean_fieldgoals[,-9], 
             method = "pearson",
             hist.col = "#00AFBB",
             density = TRUE,
             ellipses = TRUE
             )

All of our predictor values are unimodal except for defscore.

par(mfrow=c(1,2))
hist(clean_fieldgoals$defscore, xlab="defscore", main = "")

Based on the histogram above we discretize defscore

defscore = clean_fieldgoals$defscore
grp.defscore = defscore
grp.defscore[defscore %in% c(0:10)] = "1-10"
grp.defscore[defscore %in% c(11:18)] = "11-18"
grp.defscore[defscore %in% c(19:26)] = "19-26"
grp.defscore[defscore %in% c(27:99)] = "27+"
clean_fieldgoals$grp.defscore = grp.defscore
head(grp.defscore)

[1] "1-10" "1-10" "1-10" "1-10" "1-10" "1-10"

There is some correlation between the variables kickdiff vs defscore and kickdiff vs timerem.

In our smallest and final model we want to have kick difficulty, distance, time remaining because we know distance is a big indicator on whether or not a field goal is good or not and the same goes for kick difficulty and time remaining.

2 Introduction

2.0.1 Standardizing Numerical Variables

We first standardize our numerical values because we do not care about the interpretation of the coefficients only to identify the best model.

clean_fieldgoals$sd.distance = (clean_fieldgoals$distance-mean(clean_fieldgoals$distance))/sd(clean_fieldgoals$distance)
clean_fieldgoals$sd.kickdiff = (clean_fieldgoals$kickdiff-mean(clean_fieldgoals$kickdiff))/sd(clean_fieldgoals$kickdiff)
clean_fieldgoals$sd.timerem = (clean_fieldgoals$timerem-mean(clean_fieldgoals$timerem))/sd(clean_fieldgoals$timerem)
clean_fieldgoals$sd.defscore = (clean_fieldgoals$defscore-mean(clean_fieldgoals$defscore))/sd(clean_fieldgoals$defscore)

sd.GOOD = clean_fieldgoals[, -(1:4)]

2.0.2 Data Split

We randomly split the data into two sets one with 80% of the data which is used as a training data. We then use the other 20% to assess the performance of the model

n <- dim(sd.GOOD)[1]
train.n <- round(0.8*n)
train.id <- sample(1:n, train.n, replace = FALSE)
train <- sd.GOOD[train.id, ]
test <- sd.GOOD[-train.id, ]

We will use a 5-fold cross validation to make sure we have enough ield goal data.

k=5
fold.size = floor(dim(train)[1]/k)
PE1 = rep(0,5)
PE2 = rep(0,5)
PE3 = rep(0,5)

for(i in 1:k) {
  valid.id = (fold.size*(i-1)+1):(fold.size*i)
  valid = train[valid.id, ]
  train.dat = train[-valid.id,]
  
  candidate01 = glm(GOOD ~ sd.distance + sd.kickdiff + sd.timerem + 
                    grp.defscore, family = binomial(link = "logit"),  
                    data = train.dat)  

  candidate03 = glm(GOOD ~ sd.distance + grp.defscore + sd.timerem, 
                    family = binomial(link = "logit"),  
                    data = train.dat) 

  candidate02 = stepAIC(candidate01, 
                        scope = list(lower=formula(candidate03),upper=formula(candidate01)),
                        direction = "forward",   
                        trace = 0)
  
  pred01 = predict(candidate01, newdata = valid, type="response")
  pred02 = predict(candidate02, newdata = valid, type="response")
  pred03 = predict(candidate03, newdata = valid, type="response")
  
  pre.outcome01 = ifelse(as.vector(pred01) > 0.5, 1, 0)
  pre.outcome02 = ifelse(as.vector(pred02) > 0.5, 1, 0)
  pre.outcome03 = ifelse(as.vector(pred03) > 0.5, 1, 0)

  PE1[i] = sum(pre.outcome01 == valid$GOOD)/length(pred01)
  PE2[i] = sum(pre.outcome02 == valid$GOOD)/length(pred02)
  PE3[i] = sum(pre.outcome03 == valid$GOOD)/length(pred03)
}

avg.pe = cbind(PE1 = mean(PE1), PE2 = mean(PE2), PE3 = mean(PE3))
kable(avg.pe, caption = "Average of prediction errors of candidate models")

Average of prediction errors of candidate models

PE1	PE2	PE3
0.8518072	0.8518072	0.8578313

From our output above we see that model 3 has the highest prediction error of .865. We have a cutoff of .5 so our predictive error of .865 is well above our cutoff.

2.1 Final Model

pred03 = predict(candidate03, newdata = test, type="response")
pred03.outcome = ifelse(as.vector(pred02)>0.5, "1", "0")

accuracy = sum(pred03.outcome == test$GOOD)/length(pred03)

Warning in pred03.outcome == test$GOOD: longer object length is not a multiple
of shorter object length

kable(accuracy, caption="The actual accuracy of the final model")

The actual accuracy of the final model

x
0.8985507

From the output above we observe the withheld test data. We get a accuracy rate of .850.

3 Conclusion

This analysis was on predicting a made field goal. We used three models as candidates for our final model and we used cross validation. Our final result for the accuracy of our final model was approximately 85.02, which shows that the model correctly showed 85% of the test data based on the predicted probabilities and our chosen threshold of .5. An accuracy of 85% shows that the model is performing relatively well, it successfully identified whether an observation falls into the classes made (“1”) or miss (“0”) for 85% of the cases.