Introduction

In this analysis, we investigate the question: Can you predict the winning Olympic long jump distance from the year of the Games?

We also examine how far off our regression line is and how much we can trust its predictions using residuals, \(R^2\), and the residual standard error.

Step 1: Load Data & Exploratory Analysis

First, we load the required packages, load the dataset from Stat2Data, create a scatterplot of the response variable (Gold) against the explanatory variable (Year), and compute the correlation coefficient \(r\).

library(Stat2Data)
library(dplyr)
library(ggplot2)

data("LongJumpOlympics")
my_data <- LongJumpOlympics

# Scatterplot
ggplot(my_data, aes(x = Year, y = Gold)) +
  geom_point() +
  labs(
    title = "Olympic Gold Long Jump Distance over Time",
    x = "Year (Games)",
    y = "Gold Medal Distance (meters)"
  )

# Correlation coefficient
cor(my_data$Year, my_data$Gold)
## [1] 0.9017953

The correlation coefficient between Year and Gold is \(r = 0.9017953\), indicating a very strong, positive linear relationship between the year of the Games and the winning long jump distance.

Next, we fit the linear regression model:

model <- lm(Gold ~ Year, data = my_data)
coef(model)
##  (Intercept)         Year 
## -19.48359496   0.01406566

The intercept is \(-19.48359496\) and the slope is \(0.01406566\). The regression line equation is: \[\widehat{\text{Gold}} = -19.48359496 + 0.01406566 \times \text{Year}\]

Step 2: Scatterplot with Regression Line & One Residual by Hand

We plot the regression line using geom_abline() with our fitted coefficients and calculate the residual for the first observation (\(1900\) Games) by hand.

ggplot(my_data, aes(x = Year, y = Gold)) +
  geom_point() +
  geom_abline(intercept = -19.48359496, slope = 0.01406566, color = "steelblue") +
  labs(
    title = "Olympic Gold Long Jump Distance over Time with Regression Line",
    x = "Year (Games)",
    y = "Gold Medal Distance (meters)"
  )

# Inspect the first row
my_data %>%
  select(Year, Gold) %>%
  head(1)
##   Year  Gold
## 1 1900 7.185
# Calculation of residual by hand for row 1
7.185 - (0.01406566 * 1900 + -19.48359496)
## [1] -0.05615904

For the 1900 Olympic Games, the actual gold medal winning distance was \(7.185\) meters. The residual is about \(-0.056\) meters, which means the actual winning jump was approximately \(0.06\) meters below what the regression line predicted.

Step 3: Residuals and Residual Plot

We add the fitted values and residuals for all data points to my_data using fitted() and residuals(), and create a residual plot to check model assumptions.

my_data <- my_data %>%
  mutate(
    predicted = fitted(model),
    residual = residuals(model)
  )

my_data %>%
  select(Year, Gold, predicted, residual) %>%
  head()
##   Year  Gold predicted    residual
## 1 1900 7.185  7.241150 -0.05615003
## 2 1904 7.340  7.297413  0.04258735
## 3 1906 7.200  7.325544 -0.12554396
## 4 1908 7.480  7.353675  0.12632473
## 5 1912 7.600  7.409938  0.19006210
## 6 1920 7.150  7.522463 -0.37246314
# Residual plot
ggplot(my_data, aes(x = Year, y = residual)) +
  geom_point(alpha = 0.6) +
  geom_hline(yintercept = 0, color = "steelblue") +
  labs(
    title = "Residual Plot for Olympic Long Jump Model",
    x = "Year (Games)",
    y = "Residual (meters)"
  )

The residual plot appears “boring” with points randomly scattered above and below zero without any clear curved or fanning patterns. This confirms that a straight-line linear model is an appropriate fit for these data.

Step 4: Model Assessment (\(R^2\) and Residual Standard Error)

Finally, we examine the overall strength and average accuracy of our regression model using summary().

summary(model)
## 
## Call:
## lm(formula = Gold ~ Year, data = my_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.40256 -0.10991 -0.03256  0.12408  0.70239 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -19.483595   2.689700  -7.244 1.75e-07 ***
## Year          0.014066   0.001376  10.223 3.19e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2375 on 24 degrees of freedom
## Multiple R-squared:  0.8132, Adjusted R-squared:  0.8055 
## F-statistic: 104.5 on 1 and 24 DF,  p-value: 3.192e-10