getURL <- "https://raw.githubusercontent.com/deepakmongia/Data605-Spring2019/master/who.csv"
who_data <- read.csv(getURL, header = TRUE, sep = ",")
##Getting the basic statistics of the data set
summary(who_data)
## Country LifeExp InfantSurvival
## Afghanistan : 1 Min. :40.00 Min. :0.8350
## Albania : 1 1st Qu.:61.25 1st Qu.:0.9433
## Algeria : 1 Median :70.00 Median :0.9785
## Andorra : 1 Mean :67.38 Mean :0.9624
## Angola : 1 3rd Qu.:75.00 3rd Qu.:0.9910
## Antigua and Barbuda: 1 Max. :83.00 Max. :0.9980
## (Other) :184
## Under5Survival TBFree PropMD PropRN
## Min. :0.7310 Min. :0.9870 Min. :0.0000196 Min. :0.0000883
## 1st Qu.:0.9253 1st Qu.:0.9969 1st Qu.:0.0002444 1st Qu.:0.0008455
## Median :0.9745 Median :0.9992 Median :0.0010474 Median :0.0027584
## Mean :0.9459 Mean :0.9980 Mean :0.0017954 Mean :0.0041336
## 3rd Qu.:0.9900 3rd Qu.:0.9998 3rd Qu.:0.0024584 3rd Qu.:0.0057164
## Max. :0.9970 Max. :1.0000 Max. :0.0351290 Max. :0.0708387
##
## PersExp GovtExp TotExp
## Min. : 3.00 Min. : 10.0 Min. : 13
## 1st Qu.: 36.25 1st Qu.: 559.5 1st Qu.: 584
## Median : 199.50 Median : 5385.0 Median : 5541
## Mean : 742.00 Mean : 40953.5 Mean : 41696
## 3rd Qu.: 515.25 3rd Qu.: 25680.2 3rd Qu.: 26331
## Max. :6350.00 Max. :476420.0 Max. :482750
##
str(who_data)
## 'data.frame': 190 obs. of 10 variables:
## $ Country : Factor w/ 190 levels "Afghanistan",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ LifeExp : int 42 71 71 82 41 73 75 69 82 80 ...
## $ InfantSurvival: num 0.835 0.985 0.967 0.997 0.846 0.99 0.986 0.979 0.995 0.996 ...
## $ Under5Survival: num 0.743 0.983 0.962 0.996 0.74 0.989 0.983 0.976 0.994 0.996 ...
## $ TBFree : num 0.998 1 0.999 1 0.997 ...
## $ PropMD : num 2.29e-04 1.14e-03 1.06e-03 3.30e-03 7.04e-05 ...
## $ PropRN : num 0.000572 0.004614 0.002091 0.0035 0.001146 ...
## $ PersExp : int 20 169 108 2589 36 503 484 88 3181 3788 ...
## $ GovtExp : int 92 3128 5184 169725 1620 12543 19170 1856 187616 189354 ...
## $ TotExp : int 112 3297 5292 172314 1656 13046 19654 1944 190797 193142 ...
head(who_data)
## Country LifeExp InfantSurvival Under5Survival TBFree
## 1 Afghanistan 42 0.835 0.743 0.99769
## 2 Albania 71 0.985 0.983 0.99974
## 3 Algeria 71 0.967 0.962 0.99944
## 4 Andorra 82 0.997 0.996 0.99983
## 5 Angola 41 0.846 0.740 0.99656
## 6 Antigua and Barbuda 73 0.990 0.989 0.99991
## PropMD PropRN PersExp GovtExp TotExp
## 1 0.000228841 0.000572294 20 92 112
## 2 0.001143127 0.004614439 169 3128 3297
## 3 0.001060478 0.002091362 108 5184 5292
## 4 0.003297297 0.003500000 2589 169725 172314
## 5 0.000070400 0.001146162 36 1620 1656
## 6 0.000142857 0.002773810 503 12543 13046
library(ggplot2)
ggplot(who_data, aes(x=who_data$TotExp, y=who_data$LifeExp)) + geom_point()
lifeexp.totexp.lm <- lm(LifeExp ~ TotExp, who_data)
lifeexp.totexp.lm
##
## Call:
## lm(formula = LifeExp ~ TotExp, data = who_data)
##
## Coefficients:
## (Intercept) TotExp
## 6.475e+01 6.297e-05
summary(lifeexp.totexp.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
ggplot(who_data, aes(x=who_data$TotExp, y=who_data$LifeExp)) + geom_point(color = 'red') +
geom_line(aes(x = who_data$TotExp, y=predict(lifeexp.totexp.lm, newdata = who_data)), color = 'blue')
As we see above in the summary of the model, even though the p-value is very leass, but R squared is also very less. Also from the plot, it is clear that this linear model is not a good fit.
ggplot(who_data, aes(x=(who_data$TotExp ^ 0.06), y=(who_data$LifeExp ^ 4.6))) + geom_point()
lifeexp.totexp.trf.lm <- lm(I(LifeExp ^ 4.6) ~ I(TotExp ^ 0.06), who_data)
lifeexp.totexp.trf.lm
##
## Call:
## lm(formula = I(LifeExp^4.6) ~ I(TotExp^0.06), data = who_data)
##
## Coefficients:
## (Intercept) I(TotExp^0.06)
## -736527909 620060216
summary(lifeexp.totexp.trf.lm)
##
## Call:
## lm(formula = I(LifeExp^4.6) ~ I(TotExp^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 ***
## I(TotExp^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
ggplot(who_data, aes(x=(who_data$TotExp ^ 0.06), y=(who_data$LifeExp ^ 4.6))) + geom_point(color = 'red') +
geom_line(aes(x = (who_data$TotExp ^ 0.06), y=predict(lifeexp.totexp.trf.lm, newdata = who_data)), color = 'blue')
From this above plot, the linear relationship looks very clear between these 2 transformed variables.
Also as we see from the model, the R squared values are high enough to assume that this is a good fit for the data.
Hence we see that the new model fits good as compared to the model we built earlier.
LifeExp.trf.3a <- predict(lifeexp.totexp.trf.lm, newdata = data.frame(TotExp = 1.5 ^ (1/0.06)))
LifeExp.3a <- LifeExp.trf.3a ^ (1/4.6)
print(LifeExp.3a)
## 1
## 63.31153
LifeExp.trf.3b <- predict(lifeexp.totexp.trf.lm, newdata = data.frame(TotExp = 2.5 ^ (1/0.06)))
LifeExp.3b <- LifeExp.trf.3b ^ (1/4.6)
print(LifeExp.3b)
## 1
## 86.50645
LifeExp.prob4.lm <- lm(LifeExp ~ PropMD + TotExp + PropMD * TotExp, data = who_data)
summary(LifeExp.prob4.lm)
##
## Call:
## lm(formula = LifeExp ~ PropMD + TotExp + PropMD * TotExp, 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
As we see from the above model, R-squared value is very less. Hence we see that this is not a very good fit.
LifeExp.trf.5 <- predict(LifeExp.prob4.lm, newdata = data.frame(TotExp = 14, PropMD = 0.03))
print(LifeExp.trf.5)
## 1
## 107.696
The forecast does not seem to be realistic as it is a very high value which is not reasonable.