The attached who.csv dataset contains real-world data from 2008. The variables included follow.
Country: name of the country LifeExp: average life expectancy for the country in years InfantSurvival: proportion of those surviving to one year or more Under5Survival: proportion of those surviving to five years or more TBFree: proportion of the population without TB. PropMD: proportion of the population who are MDs PropRN: proportion of the population who are RNs PersExp: mean personal expenditures on healthcare in US dollars at average exchange rate GovtExp: mean government expenditures per capita on healthcare, US dollars at average exchange rate TotExp: sum of personal and government expenditures.
library(knitr)
url <- "C:/cuny/Fall_2017/DATA-605/Assignment12/who.csv"
rwd <- read.csv(file = url, header = T, stringsAsFactors = F)
summary(rwd)
## Country LifeExp InfantSurvival Under5Survival
## Length:190 Min. :40.00 Min. :0.8350 Min. :0.7310
## Class :character 1st Qu.:61.25 1st Qu.:0.9433 1st Qu.:0.9253
## Mode :character Median :70.00 Median :0.9785 Median :0.9745
## Mean :67.38 Mean :0.9624 Mean :0.9459
## 3rd Qu.:75.00 3rd Qu.:0.9910 3rd Qu.:0.9900
## Max. :83.00 Max. :0.9980 Max. :0.9970
## TBFree PropMD PropRN
## Min. :0.9870 Min. :0.0000196 Min. :0.0000883
## 1st Qu.:0.9969 1st Qu.:0.0002444 1st Qu.:0.0008455
## Median :0.9992 Median :0.0010474 Median :0.0027584
## Mean :0.9980 Mean :0.0017954 Mean :0.0041336
## 3rd Qu.:0.9998 3rd Qu.:0.0024584 3rd Qu.:0.0057164
## 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
kable(head(rwd))
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 |
#scatter plot
plot(rwd$LifeExp, rwd$TotExp, main="Scatterplot",
xlab="Life Expectancy ", ylab="Total Expenidutres ", pch=19)
#simple linear regression
lm_rwd <- lm(rwd$LifeExp ~ rwd$TotExp)
abline(lm_rwd, col = "red")
#residuals
hist(resid(lm_rwd), main = "Histogram of Residuals", xlab = "residuals")
#summary
summary(lm_rwd)
##
## Call:
## lm(formula = rwd$LifeExp ~ rwd$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 ***
## rwd$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
#simple linear regression
x <- rwd$LifeExp^4.6
y <- rwd$TotExp^0.06
lm_rwd2 <- lm(x ~ y)
#scatter plot
plot(x, y, main="Scatterplot 2",
xlab="Life Expectancy ", ylab="Total Expenidutres ", pch=19)
abline(lm_rwd2, col = "red")
#residuals
hist(resid(lm_rwd2), main = "Histogram of Residuals", xlab = "residuals")
#summary
summary(lm_rwd2)
##
## Call:
## lm(formula = x ~ y)
##
## 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 ***
## y 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
plot(fitted(lm_rwd), resid(lm_rwd))
plot(fitted(lm_rwd2), resid(lm_rwd2))
Model2 is highly different and better compared to Model1. Adjusted Rsquare is 72% whereas Model1 is only 25%. 72% can be explained by model2. There seems to be a good correlation. p-value is less in Model2 compared to Model1. F-stat is 507 in model2 whereas only 65 in Model1. Residual standard error is high in Model2 and normally distributed in Model2.
\[y= -736527910 + 620060216 x\]
\[life expectancy = y^(1/4.6)\]
le <- function(fc)
{ y <- -736527910 + 620060216 * (fc)
y <- y^(1/4.6)
print(y)
}
#Life expectancy when TotExp^.06 =1.5
le(1.5)
## [1] 63.31153
#Life expectancy when TotExp^.06 =2.5
le(2.5)
## [1] 86.50645
lm_fit3 <- lm(rwd$LifeExp ~ rwd$PropMD + rwd$TotExp + rwd$PropMD*rwd$TotExp)
summary(lm_fit3)
##
## Call:
## lm(formula = rwd$LifeExp ~ rwd$PropMD + rwd$TotExp + rwd$PropMD *
## rwd$TotExp)
##
## 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 ***
## rwd$PropMD 1.497e+03 2.788e+02 5.371 2.32e-07 ***
## rwd$TotExp 7.233e-05 8.982e-06 8.053 9.39e-14 ***
## rwd$PropMD:rwd$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
hist(resid(lm_fit3), main = "Histogram of Residuals", xlab = "residuals")
plot(fitted(lm_fit3), resid(lm_fit3))
p-value is less than .05. model is statistically significant. F-statistic is 34.49 by adding 3 variables. Based on Rsquare only 35% of the variability can be explained by 3 variables. Correlation is moderate in this case. Residuals is right skewed. So, linear model is not valid.
\[LifeExp = 6.277 * 10^1 + 1.497*10^3 * PropMD + 7.233* 10^-5 TotExp-6.026*10^-3 *PropMD*TotExp\]
LE <- ( (6.277*10^1) + (1.497*10^3)*.03 + (7.233*10^(-5))*14 - ((6.026*10^(-3))*0.03*14) )
LE
## [1] 107.6785
###The forecast age 107.6 is an outlier and seems to be unrealistic. The expenditure is also low.