Setup and Data Exploration

First, we load the required packages and the dataset from Stat2Data.

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

data("LongJumpOlympics")
my_data <- LongJumpOlympics

Next, we create a scatterplot to explore the relationship between the year of the Olympic Games and the gold medal winning distance.

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

We compute the correlation coefficient \(r\) between Year and Gold:

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

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

Fitting the Linear Model

We fit a linear model using Gold as the response variable (\(y\)) and Year as the explanatory variable (\(x\)).

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

The fitted regression line equation is:

\[\widehat{\text{Gold}} = -19.48359496 + 0.01406566 \times \text{Year}\]

We plot the regression line on top of our scatterplot using geom_abline():

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

Hand Residual Calculation

We look at the first observation in the dataset (the 1900 Olympic Games):

my_data %>% 
  select(Year, Gold) %>% 
  head(1)
##   Year  Gold
## 1 1900 7.185

For \(x = 1900\) and actual \(y = 7.185\) meters:

The actual winning long jump in 1900 was approximately \(0.056\) meters below the predicted distance.

Residual Analysis

We mutate our dataset to store the predicted values and residuals for all observations, and then display the head of the dataset:

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

To evaluate our model’s fit, we construct a 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 shows a boring cloud with no clear pattern or structure. This confirms that using a straight-line linear model is appropriate for these data.

Model Evaluation: \(R^2\) and Residual Standard Error

We examine the model summary output:

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

Interpretation:

  • Multiple \(R^2 = 0.8132\): Approximately \(81.32\%\) of the variation in gold medal long jump distances is explained by the year of the Olympic Games.
  • Residual Standard Error \(= 0.2375\) meters: Predictions from this linear model are typically off by about \(0.2375\) meters (or about \(23.75\) cm).