Data 605 - Assignment 12
Habib Khan
April 26, 2020
Week 13 Assignment - Multiple Regression in R
# Loading the data
data <- read.csv("who.csv", header = TRUE)
glimpse(data)## Observations: 190
## Variables: 10
## $ Country <fct> Afghanistan, Albania, Algeria, Andorra, Angola,...
## $ LifeExp <int> 42, 71, 71, 82, 41, 73, 75, 69, 82, 80, 64, 74,...
## $ InfantSurvival <dbl> 0.835, 0.985, 0.967, 0.997, 0.846, 0.990, 0.986...
## $ Under5Survival <dbl> 0.743, 0.983, 0.962, 0.996, 0.740, 0.989, 0.983...
## $ TBFree <dbl> 0.99769, 0.99974, 0.99944, 0.99983, 0.99656, 0....
## $ PropMD <dbl> 0.000228841, 0.001143127, 0.001060478, 0.003297...
## $ PropRN <dbl> 0.000572294, 0.004614439, 0.002091362, 0.003500...
## $ PersExp <int> 20, 169, 108, 2589, 36, 503, 484, 88, 3181, 378...
## $ GovtExp <int> 92, 3128, 5184, 169725, 1620, 12543, 19170, 185...
## $ TotExp <int> 112, 3297, 5292, 172314, 1656, 13046, 19654, 19...head(data) %>% kable() | Country | LifeExp | InfantSurvival | Under5Survival | TBFree | PropMD | PropRN | PersExp | GovtExp | TotExp |
|---|---|---|---|---|---|---|---|---|---|
| Afghanistan | 42 | 0.835 | 0.743 | 0.99769 | 0.0002288 | 0.0005723 | 20 | 92 | 112 |
| Albania | 71 | 0.985 | 0.983 | 0.99974 | 0.0011431 | 0.0046144 | 169 | 3128 | 3297 |
| Algeria | 71 | 0.967 | 0.962 | 0.99944 | 0.0010605 | 0.0020914 | 108 | 5184 | 5292 |
| Andorra | 82 | 0.997 | 0.996 | 0.99983 | 0.0032973 | 0.0035000 | 2589 | 169725 | 172314 |
| Angola | 41 | 0.846 | 0.740 | 0.99656 | 0.0000704 | 0.0011462 | 36 | 1620 | 1656 |
| Antigua and Barbuda | 73 | 0.990 | 0.989 | 0.99991 | 0.0001429 | 0.0027738 | 503 | 12543 | 13046 |
Q1
# Visualize the predictor
ggplot(data, aes(TotExp, LifeExp))+geom_point()+theme_classic()+geom_smooth(method="lm", se = FALSE)+labs(title="Life expectancy vs total expectancy")## `geom_smooth()` using formula 'y ~ x'
# Creating a regression model
model <- lm(data$LifeExp ~ data$TotExp)
summary(model)##
## Call:
## lm(formula = data$LifeExp ~ data$TotExp)
##
## 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 ***
## data$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# Checking the normality
qqnorm(model$residuals)
qqline(model$residuals)
There is positive relationship between lifeExp and TotExp as the line shows above in the scatterplot. Also to double check, regression model was calculated and result shows that the model 25.77% variance and with the 1 unit increases in TotExp, LifeExp will be increased with 6.29 x 10^5. LifeExp has positive significant impact on TotExp. The problem is the qqnorm plot does not show randomness and hence data isn’t random.
Q2
# Transformed regression
t_TotExp <- data$TotExp ^ 0.06
t_LifeExp <- data$LifeExp ^ 4.6
# Visualize with transformed variables
ggplot(data, aes(x=t_LifeExp,y=t_TotExp))+geom_point()+geom_smooth(method="lm",se=FALSE)## `geom_smooth()` using formula 'y ~ x'
model2 <- lm(t_LifeExp ~ t_TotExp)
summary(model2)##
## Call:
## lm(formula = t_LifeExp ~ t_TotExp)
##
## 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 ***
## t_TotExp 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-16After transforming both variables, the model has improved significantly. Now the model predicts 72.98 percent. Also, with the 1 unit increase in Life, LifeExp will increase with 620060216 units. It can be seen that the new model is better than the old model. It has improved significantly.
Q3
# Forecast life expectancy with TotExp ^ 0.06 = 1.5
life_exp1.5 <- (-736527910 + 620060216*1.5) ^ (1/4.6)
print(paste("The life expectancy is ", life_exp1.5, "when Tot Exp ^ 0.06 = 1.5"))## [1] "The life expectancy is 63.3115334478635 when Tot Exp ^ 0.06 = 1.5"# Forecast life expectancy with Total Exp ^ 0.06 = 2.5
life_exp2.5 <- (-736527910 + 620060216*2.5) ^ (1/4.6)
print(paste("The life expectancy is ", life_exp2.5, "when Tot Exp ^ 0.06 = 2.5"))## [1] "The life expectancy is 86.5064484928337 when Tot Exp ^ 0.06 = 2.5"Q4
model4 <- lm(LifeExp ~ TotExp + PropMD + PropMD*TotExp, data=data)
summary(model4)##
## Call:
## lm(formula = LifeExp ~ TotExp + PropMD + PropMD * TotExp, data = 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 ***
## TotExp 7.233e-05 8.982e-06 8.053 9.39e-14 ***
## PropMD 1.497e+03 2.788e+02 5.371 2.32e-07 ***
## TotExp:PropMD -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-16qqnorm(model4$residuals)
qqline(model4$residuals)
The model is:
LifeExp = 6.27710 + 7.233^-05(TotExp) + 1.497^03(PropMD) - 6.026^-03(TotExp*PropMD)
Model shows only 35.74 variance which is not very good. All the p-values for predictors are very small and hence they all having significant impact on LifeExp. F-statistics’ p-value shows that there is variation in the mean of predictors. Residuals show that the there is normal distribution around 0 and hence it’s good.
Q5
lifeExp_5 <- (6.277*10) + (1.497*10^3)*0.03 + (7.233*10^-5)*14 - (6.025*10^-3) * (14*0.03)
print(paste0("The life expectancy when PropMD = 0.03 and TotExp = 14 is ", lifeExp_5))## [1] "The life expectancy when PropMD = 0.03 and TotExp = 14 is 107.67848212"Although the result says almost 107 years but it’s very much skewed and not realistic.