Group Report and Appendix

Model summary

model <- lm(Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources 
            + BMI + Schooling, data = train_data)
summary(model)
## 
## Call:
## lm(formula = Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + 
##     BMI + Schooling, data = train_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -17.6859  -2.0695  -0.0735   2.2702  11.4243 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     52.426271   0.639296  82.006  < 2e-16 ***
## Adult.Mortality                 -0.017952   0.001155 -15.549  < 2e-16 ***
## HIV.AIDS                        -0.448658   0.021273 -21.090  < 2e-16 ***
## Income.composition.of.resources 11.275758   1.031243  10.934  < 2e-16 ***
## BMI                              0.038583   0.006800   5.674 1.77e-08 ***
## Schooling                        1.005387   0.067836  14.821  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.771 on 1148 degrees of freedom
## Multiple R-squared:  0.8192, Adjusted R-squared:  0.8184 
## F-statistic:  1040 on 5 and 1148 DF,  p-value: < 2.2e-16
  • Summary: All predictors’ p-values are all way below the alpha value of 0.05. We can conclude that there is evidence that there is a statistically significant relationship between each predictor and the life expectancy, meaning the predictors are not equal to zero and have a meaningful impact on the model’s prediction. The overall model’s p-value is also less than 0.05, meaning the independent variables collectively have a statistically significant effect on the life expectancy. The R-squared and Adjusted R-squared are very close to each other in value, indicating that current predictors are relevant and adding more might not increase the its explanatory power.

Residual analysis results

# Normal Q-Q
qqnorm(model$residuals, main = "Q-Q Norm Residuals")
qqline(model$residuals)

# Residuals vs Fitted
plot(model$fitted.values, model$residuals,
  xlab = "Fitted Values", ylab = "Residuals", main = "Residuals vs Fitted")

# Histogram
hist(residuals(model), main = "Histogram of Residuals")

  • Summary: Residuals vs Fitted Values plot has a random pattern, so the constant variance assumption is met. The histogram of residuals looks symmetrical so the residuals follow an approximate normal distribution. In the Q-Q Normal plot, there are deviations present on the tails, indicating that the distribution is slightly skewed.

Model assessment comparison

data.frame(
  Member   = c("Chloe", "Mihir", "Rhea", "Ryan"),
  Train_R2 = c(0.79, 0.81, 0.81, 0.81),
  Test_R2  = c(0.82, 0.82, 0.83, 0.82),
  RMSE     = c(4.1, 3.8, 3.9, 3.8),
  Comments = c("Overall good fit.", "Overall good fit.", "Overall good fit.", "Overall good fit.")
)

Group synthesis paragraph

  • The Variance Inflation Factor values each person got were below 5, which means that multicolinearity has a low chance of existing in our model. Each predictor in our model was significant as all the p-values were below alpha = 0.05, so all predictors were kept in our adjusted model. Our predictors have no redundancy since all of our variable are diverse. All assumptions were met except for the normal Q-Q as there was deviation from the tails. We plan to refine the model by adding an interaction term between Income.composition.of.resources & Schooling and/or HIV.AIDS & Adult.Mortality. We will also look into transformation.

Appendix

Chloe Lavery:

# Set seed and split data
set.seed(11142023)    
n1 <- nrow(LE)
train_index1 <- sample(1:n, size = 0.7 *  n)
train_data1 <- data[train_index1, ]
test_data1  <- data[-train_index1, ]

# Training Data Model
model1 <- lm(Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + BMI + Schooling, train_data1) 

car::vif(model1)
##                 Adult.Mortality                        HIV.AIDS 
##                        1.999296                        1.615130 
## Income.composition.of.resources                             BMI 
##                        2.880428                        1.658026 
##                       Schooling 
##                        3.179916
# Residual Analysis
plot(model1) # Residual vs. fitted plot, Normal Q-Q plot

hist(resid(model1), main = "Histogram of Residuals", xlab = "Residuals") # Histogram of residuals

# Model Assessment
vars <- c("Life.expectancy", "Adult.Mortality", "HIV.AIDS", "Income.composition.of.resources", "BMI", "Schooling")
clean_test <- test_data1[complete.cases(test_data[vars]), ]

pred_test <- predict(model1, newdata = clean_test)
RMSE1 <- sqrt(mean((clean_test$Life.expectancy - pred_test)^2))
cat("Chloe Lavery's Output:\n")
## Chloe Lavery's Output:
cat("RMSE (testing):", RMSE1, "\n")
## RMSE (testing): NA
cat("R^2 (training):", summary(model1)$r.squared)
## R^2 (training): 0.8138573
tMod <- lm(Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + BMI + Schooling, test_data)
cat("\nR^2 (testing):", summary(tMod)$r.squared)
## 
## R^2 (testing): 0.8035703

Mihir Ranjan:

# Set seed and split data
set.seed(1450034)
n2 <- nrow(LE)
train_index2 <- sample(1:n, size = 0.7 * n)
train_data2 <- LE[train_index2, ]
test_data2 <- LE[-train_index2, ]


# Training Data Model
model2 <- lm(Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + BMI + Schooling, data = train_data2) 
summary(model2)
## 
## Call:
## lm(formula = Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + 
##     BMI + Schooling, data = train_data2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -17.6458  -2.0385   0.0033   2.2065  11.5002 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     52.325788   0.640836  81.652  < 2e-16 ***
## Adult.Mortality                 -0.017565   0.001192 -14.740  < 2e-16 ***
## HIV.AIDS                        -0.439462   0.022469 -19.558  < 2e-16 ***
## Income.composition.of.resources 11.160116   1.020802  10.933  < 2e-16 ***
## BMI                              0.039310   0.006939   5.665 1.86e-08 ***
## Schooling                        1.013005   0.068014  14.894  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.79 on 1148 degrees of freedom
## Multiple R-squared:  0.8134, Adjusted R-squared:  0.8126 
## F-statistic:  1001 on 5 and 1148 DF,  p-value: < 2.2e-16
car::vif(model2)
##                 Adult.Mortality                        HIV.AIDS 
##                        1.799384                        1.488789 
## Income.composition.of.resources                             BMI 
##                        2.789616                        1.521798 
##                       Schooling 
##                        2.910026
# Residual Analysis
plot(model2) 

hist(resid(model2), main = "Hist of residuals with seed 1450034", xlab = "Residuals")

# Model Assessment
pred_test2 <- predict(model2, newdata = test_data2)

res_test2 <- test_data2$Life.expectancy - pred_test2

RMSE_test2 <- sqrt(mean(res_test2^2))
RMSE_test2
## [1] 3.820172

Ryan Hsu:

# Set seed and split data
set.seed(309579)
n3 <- nrow(LE)
train_index3 <- sample(1:n, size = 0.7 * n)
train_data3 <- LE[train_index3, ]
test_data3 <- LE[-train_index3, ]


# Training Data Model
model3 <- lm(Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + BMI + Schooling, data = train_data3) 
summary(model3)
## 
## Call:
## lm(formula = Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + 
##     BMI + Schooling, data = train_data3)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -13.2338  -2.0672   0.0453   2.1833  11.5621 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     52.931384   0.646881  81.825  < 2e-16 ***
## Adult.Mortality                 -0.019435   0.001175 -16.540  < 2e-16 ***
## HIV.AIDS                        -0.447304   0.022897 -19.536  < 2e-16 ***
## Income.composition.of.resources 11.177635   1.023643  10.919  < 2e-16 ***
## BMI                              0.040269   0.006795   5.926  4.1e-09 ***
## Schooling                        0.983053   0.068814  14.286  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.777 on 1148 degrees of freedom
## Multiple R-squared:  0.8111, Adjusted R-squared:  0.8103 
## F-statistic: 985.8 on 5 and 1148 DF,  p-value: < 2.2e-16
car::vif(model3)
##                 Adult.Mortality                        HIV.AIDS 
##                        1.628978                        1.346708 
## Income.composition.of.resources                             BMI 
##                        2.835494                        1.467694 
##                       Schooling 
##                        3.011363
# Residual Analysis
plot(model3$fitted.values, model3$residuals, xlab = "Fitted Values", ylab = "Residuals",
     main = "Residuals vs Fitted")
abline(h = 0, col = 'red')

hist(resid(model3), main = "Hist of residuals with seed 309579", xlab = "Residuals")

qqnorm(model3$residuals, main = "Normal Q-Q Plot")
qqline(model3$residuals, col = 'red')

hist(model3$residuals)

# Model Assessment 
pred_test3 <- predict(model3, newdata = test_data3)

res_test3 <- test_data3$Life.expectancy - pred_test3

RMSE_test3 <- sqrt(mean(res_test3^2))
RMSE_test3
## [1] 3.844196
model_test3 <- lm(Life.expectancy ~ Schooling + Income.composition.of.resources + Adult.Mortality + HIV.AIDS + BMI, data = test_data3)
summary(model_test3)$r.squared
## [1] 0.8220816
summary(model3)$r.squared
## [1] 0.811087

Rhea Verma:

# Set seed and split data
set.seed(127) 
n4 <- nrow(LE)
train_index4 <- sample(1:n, size = 0.7*n)
train_data4 <- LE[train_index4, ]
test_data4  <- LE[-train_index4, ]


# Training Data Model
model4 <- lm(Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + BMI + Schooling, data = train_data4)
summary(model4)
## 
## Call:
## lm(formula = Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + 
##     BMI + Schooling, data = train_data4)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -17.3879  -2.2087  -0.0205   2.2198  12.5720 
## 
## Coefficients:
##                                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     52.025583   0.630026  82.577  < 2e-16 ***
## Adult.Mortality                 -0.017713   0.001128 -15.701  < 2e-16 ***
## HIV.AIDS                        -0.487421   0.022051 -22.105  < 2e-16 ***
## Income.composition.of.resources 11.335809   1.026144  11.047  < 2e-16 ***
## BMI                              0.041611   0.006824   6.098 1.47e-09 ***
## Schooling                        1.023577   0.066392  15.417  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.786 on 1148 degrees of freedom
## Multiple R-squared:  0.8118, Adjusted R-squared:  0.811 
## F-statistic: 990.3 on 5 and 1148 DF,  p-value: < 2.2e-16
car::vif(model4)
##                 Adult.Mortality                        HIV.AIDS 
##                        1.495492                        1.269513 
## Income.composition.of.resources                             BMI 
##                        2.755007                        1.472329 
##                       Schooling 
##                        2.814731
# Residual Analysis

par(mfrow = c(2,2))

  # Normal Q-Q
qqnorm(model4$residuals, xlab = "Theoretical Quantities", ylab = "Residuals", 
       main = "Q-Q Norm Residuals")
qqline(model4$residuals)

  # Residuals vs Fitted
plot(model$fitted.values, model$residuals,
  xlab = "Fitted Values", ylab = "Residuals", main = "Residuals vs Fitted")

  # Histogram
hist(residuals(model4), xlab = "Residuals", ylab = "Frequency", main = "Histogram of Residuals")



# Model Assessment 
pred_test4 <- predict(model4, newdata = test_data4)
RMSE4 <- sqrt(mean((test_data4$Life.expectancy - pred_test4)^2))

RMSE4
## [1] 3.8534
test_model4 <- lm(Life.expectancy ~ Adult.Mortality + HIV.AIDS + Income.composition.of.resources + BMI + Schooling, data = test_data4)
summary(test_model4)$r.squared # Test R²
## [1] 0.8296045