The attached who_data.csv dataset contains real-world data from 2008. The variables included follow.
# Libraries
library(ggplot2)
who_data <- read.csv('https://raw.githubusercontent.com/nathtrish334/Data-605/main/who.csv')
head(who_data)
## Country LifeExp InfantSurvival Under5Survival TBFree PropMD
## 1 Afghanistan 42 0.835 0.743 0.99769 0.000228841
## 2 Albania 71 0.985 0.983 0.99974 0.001143127
## 3 Algeria 71 0.967 0.962 0.99944 0.001060478
## 4 Andorra 82 0.997 0.996 0.99983 0.003297297
## 5 Angola 41 0.846 0.740 0.99656 0.000070400
## 6 Antigua and Barbuda 73 0.990 0.989 0.99991 0.000142857
## PropRN PersExp GovtExp TotExp
## 1 0.000572294 20 92 112
## 2 0.004614439 169 3128 3297
## 3 0.002091362 108 5184 5292
## 4 0.003500000 2589 169725 172314
## 5 0.001146162 36 1620 1656
## 6 0.002773810 503 12543 13046
# Linear regression model
life_exp_lm <- lm(LifeExp ~ TotExp, data=who_data)
# Scatterplot
plot(LifeExp~TotExp, data=who_data,
xlab="Total Expenditures", ylab="Life Expectancy",
main="Life Expectancy vs Total Expenditures")
abline(life_exp_lm)
# Summary of Linear regression model
summary(life_exp_lm)
##
## Call:
## lm(formula = LifeExp ~ TotExp, data = who_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -24.764 -4.778 3.154 7.116 13.292
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.475e+01 7.535e-01 85.933 < 2e-16 ***
## TotExp 6.297e-05 7.795e-06 8.079 7.71e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.371 on 188 degrees of freedom
## Multiple R-squared: 0.2577, Adjusted R-squared: 0.2537
## F-statistic: 65.26 on 1 and 188 DF, p-value: 7.714e-14
# Residuals variability plot
plot(life_exp_lm$fitted.values, life_exp_lm$residuals,
xlab="Fitted Values", ylab="Residuals",
main="Residuals Plot")
abline(h=0)
# Residuals Q-Q plot
qqnorm(life_exp_lm$residuals)
qqline(life_exp_lm$residuals)
Discussion
The regression output, R^2, indicates that ONLY 25.77% of variation in life expectancy is explained by the total expenditure. The Standard Error is approximately 8x smaller then the corresponding coefficient. P-value is small in indicating that the total expenditure is a significant variable and hence likely to impact life expectancy. As a result, we reject the null hypothesis. F-Statistic is Very large, indicating a stronger relationship between the independent and dependent variables. The residual plot shows there is no constant variability and the residuals are not normally distributed. Hence, this model is not good enough to describe the relationship between total expenditure and life expectancy.
# Transformation
LifeExp_by_4.6 <- who_data$LifeExp^4.6
TotExp_by_0.06 <- who_data$TotExp^0.06
# Linear regression model build
life_exp_lm_transformed <- lm(LifeExp_by_4.6 ~ TotExp_by_0.06, who_data)
# Scatterplot of dependent and independent variables
plot(LifeExp_by_4.6~TotExp_by_0.06,
xlab="Total Expenditures", ylab="Life Expectancy",
main="Life Expectancy vs Total Expenditures (Transformed)")
abline(life_exp_lm_transformed)
# Summary of Linear regression model summary
summary(life_exp_lm_transformed)
##
## Call:
## lm(formula = LifeExp_by_4.6 ~ TotExp_by_0.06, data = who_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -308616089 -53978977 13697187 59139231 211951764
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -736527910 46817945 -15.73 <2e-16 ***
## TotExp_by_0.06 620060216 27518940 22.53 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 90490000 on 188 degrees of freedom
## Multiple R-squared: 0.7298, Adjusted R-squared: 0.7283
## F-statistic: 507.7 on 1 and 188 DF, p-value: < 2.2e-16
# Residuals variability plot
plot(life_exp_lm_transformed$fitted.values, life_exp_lm_transformed$residuals,
xlab="Fitted Values", ylab="Residuals",
main="Residuals Plot")
abline(h=0)
# Residuals Q-Q plot
qqnorm(life_exp_lm_transformed$residuals)
qqline(life_exp_lm_transformed$residuals)
Discussion
The transformed model is a better model since the data points are more closely clustterred around the regression line of the model. R-squared value, 72.98%, is much better than the 25.77% for the first model. Hence, the response variable (life expentancy^4.6) explains the model’s variability around the mean 72.98% of the time. The p-value of the model, < 2.2e-16, is really low, hence we can confindetly reject the null hypothesis. The F-statistic,507.7, is good, but the Standard Error, 90490000, is a bit high. From the residuals plot, variability is fairly constant with a few outliers and distribution of residuals is nearly normal with some deviation at the tails. Hence, this is a fairly good model to describe the relationship and it is significantly better than the first model. From the new scatterplot, there is a clear linear relationship between transformed variables.
new_outcome <- data.frame(TotExp_by_0.06=c(1.5,2.5))
predict(life_exp_lm_transformed,new_outcome,interval="predict")^(1/4.6)
## fit lwr upr
## 1 63.31153 35.93545 73.00793
## 2 86.50645 81.80643 90.43414
When TotExp^0.06=1.5, the forecasted life expectancy is 63.31 years with a 95% confidence interval between 35.94 and 73.01. When TotExp^0.06=2.5, the forecasted life expectancy is 86.51 years with a 95% confidence interval between 81.81 and 90.43.
#Linear regression
life_exp_lm_qn4 <- lm(LifeExp ~ PropMD + TotExp + TotExp:PropMD, who_data)
summary(life_exp_lm_qn4)
##
## Call:
## lm(formula = LifeExp ~ PropMD + TotExp + TotExp:PropMD, data = who_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -27.320 -4.132 2.098 6.540 13.074
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.277e+01 7.956e-01 78.899 < 2e-16 ***
## PropMD 1.497e+03 2.788e+02 5.371 2.32e-07 ***
## TotExp 7.233e-05 8.982e-06 8.053 9.39e-14 ***
## PropMD:TotExp -6.026e-03 1.472e-03 -4.093 6.35e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.765 on 186 degrees of freedom
## Multiple R-squared: 0.3574, Adjusted R-squared: 0.3471
## F-statistic: 34.49 on 3 and 186 DF, p-value: < 2.2e-16
#Residuals plot
plot(life_exp_lm_qn4$fitted.values, life_exp_lm_qn4$residuals, xlab="Fitted Values", ylab="Residuals",
main="Fitted Values vs.Residuals")
# Normal Q-Q plot
qqnorm(life_exp_lm_qn4$residuals)
qqline(life_exp_lm_qn4$residuals)
Results
Residual Standard Error is 8.765 and F-statistic is 34.49. The p-value is really low (< 2.2e-16), hence we can reject the null hypothesis. Since average life expectancy is 67.38, the SE is not terrible and F-statistics is fairly high (but lower than in the first model). R2 is only 0.3574, hence the model explains only 35.74% of variability, which is not high. P-value is nearly 0, so the relationship is not due to random variation.From the residuals plots, there is no constant variability and that residuals are not normally distributed. This is not a good model to describe the relationship. It is almost similar to the first model.
new_outcome_01 <- data.frame(PropMD=0.03, TotExp=14)
predict(life_exp_lm_qn4,new_outcome_01,interval="predict")
## fit lwr upr
## 1 107.696 84.24791 131.1441
Discussion
Life expectancy is predicted to be 107.70 years with 95% confidence interval between 84.25 and 131.14. This prediction is unrealistic since the highest life expectancy in the WHO data is 83 years old.