1 Data Acquisition

library(tidyverse)
library(olsrr)
library(car)
library(gvlma)
library(kableExtra)
library(knitr)
options(scipen=8) #removes scinotation
data_df <- read.csv("https://raw.githubusercontent.com/niteen11/CUNY_DATA_605/master/Week12/who.csv", header = T)
kable(head(data_df,10))
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
Argentina 75 0.986 0.983 0.99952 0.0027802 0.0007410 484 19170 19654
Armenia 69 0.979 0.976 0.99920 0.0036987 0.0049189 88 1856 1944
Australia 82 0.995 0.994 0.99993 0.0023320 0.0091494 3181 187616 190797
Austria 80 0.996 0.996 0.99990 0.0036109 0.0064587 3788 189354 193142

1.1 Variables

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.

summary(data_df)
##                 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  
##

2 Problem 1

Provide a scatterplot of LifeExp~TotExp, and run simple linear regression. Do not transform the variables. Provide and interpret the F statistics, \(R^2\) , standard error,and p-values only. Discuss whether the assumptions of simple linear regression met.

attach(data_df)
library(ggplot2)
plot1 <- ggplot(data_df, aes(TotExp,LifeExp)) + 
  geom_point() +
  geom_smooth(method='lm', se = FALSE, color = 'red') +
  labs(title = "Scatterplot of LifeExp~TotExp") +
  scale_x_continuous(labels = scales::comma)
plot1

model1 <- lm(LifeExp ~TotExp  , data_df)
summary(model1)
## 
## Call:
## lm(formula = LifeExp ~ TotExp, data = data_df)
## 
## 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) 64.753374534  0.753536611  85.933  < 2e-16 ***
## TotExp       0.000062970  0.000007795   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
par(mfrow = c(2,2))
plot(model1)

The F - statistic from this model is 65.26 (the model has one regression degree of freedom and 188 degrees of freedom). F - table value for one regression degree of freedom and 120 residual degrees of freedom is 6.851. Since our model’s F-statistic is much greater than the F-table value, this suggests we can reject the Null hypothesis, a regression model with a zero coefficient. The p value is near 0. The \(R^2=0.2577\) tells us that 25.77% of the variation in the data is accounted for the model; The model does not strongly fit the data. The standard error is a reasonably small percentage of the coefficient.

detach(data_df)

3 Problem 2

Raise life expectancy to the 4.6 power (i.e., \(LifeExp^{4.6}\)). Raise total expenditures to the 0.06 power (nearly a log transform, \(TotExp^{.06}\)). Plot \(LifeExp^{4.6}\) as a function of \(TotExp^{.06}\), and re-run the simple regression model using the transformed variables. Provide and interpret the F statistics, \(R^2\), standard error, and p-values. Which model is “better?”

data_df$LifeExp4.6 <- data_df$LifeExp^4.6
data_df$TotExp0.06 <- data_df$TotExp^.06

attach(data_df)

plot2 <- ggplot(data_df, aes(TotExp0.06, LifeExp4.6)) + 
  geom_point() +
  geom_smooth(method='lm', se = FALSE, color = 'blue') +
  labs(title = "Scatterplot of LifeExp~TotExp") +
  scale_y_continuous(labels = scales::comma)
plot2

model2 <- lm(LifeExp4.6~TotExp0.06)
summary(model2)
## 
## Call:
## lm(formula = LifeExp4.6 ~ TotExp0.06)
## 
## 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 ***
## TotExp0.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
par(mfrow = c(2,2))
plot(model2)

The transformed model shows F-statistic 507.7 which is better than model1 and 188 degree of freedom. The P-value is also more statistically significant than the previous model. The \(R^2\) value is 0.7298, which is higher than the model 1 \(R^2\) value. The standard residual error is 90,490,000 and is significantly higher than the previous model. The residual plot also shows few outliers.

4 Problem 3

Using the results from 3, forecast life expectancy when \(TotExp^.06 =1.5\). Then forecast life expectancy when \(TotExp^.06=2.5\).

The model is \(\widehat{LifeExp4.6} = 736527910 + 620060216 * TotExp0.06\)

predict.TotExp <- function(x){
  n <- model2$coefficients[1] + model2$coefficients[2] * x
  return(n ** (1/4.6))
}

#TotExp^.06=1.5
predict.TotExp(1.5)
## (Intercept) 
##    63.31153
#TotExp^.06=2.5
predict.TotExp(2.5)
## (Intercept) 
##    86.50645

5 Problem 4

Build the following multiple regression model and interpret the F Statistics, \(R^2\), standard error, and p-values. How good is the model?

\(LifeExp = \beta0 + \beta1 \times PropMd + \beta2 \times TotExp + \beta3 \times PropMD \times TotExp\)

detach(data_df)

data_df$PropMD.TotExp <- data_df$PropMD * data_df$TotExp
attach(data_df)

model4 <- lm(LifeExp ~ PropMD + TotExp + PropMD.TotExp)
summary(model4)
## 
## Call:
## lm(formula = LifeExp ~ PropMD + TotExp + PropMD.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)     62.772703255    0.795605238  78.899  < 2e-16 ***
## PropMD        1497.493952519  278.816879652   5.371 2.32e-07 ***
## TotExp           0.000072333    0.000008982   8.053 9.39e-14 ***
## PropMD.TotExp   -0.006025686    0.001472357  -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
par(mfrow = c(2,2))
plot(model4)
## Warning in sqrt(crit * p * (1 - hh)/hh): NaNs produced

## Warning in sqrt(crit * p * (1 - hh)/hh): NaNs produced

A residual standard error 8.765 is improved as compare to the moddel 1. The \(R^2\) is only 0.3574, meaniing the model explains only 35.74% of variability which is pretty low. The P - value <2.2e-16 is statistically signifiicant.

6 Problem 5

Forecast LifeExp when \(PropMD=.03\) and \(TotExp = 14\). Does this forecast seem realistic? Why or why not?

\(\widehat{LifeExp} = \beta0 + \beta1 \times PropMd + \beta2 \times TotExp + \beta3 \times PropMD \times TotExp\)

predict_05 <- data.frame(PropMD=0.03, TotExp=14, PropMD.TotExp = 14*0.03)

predict(model4, predict_05,interval="predict")
##       fit      lwr      upr
## 1 107.696 84.24791 131.1441

The predicted range of vaulues appear to be very high. The predicted life expectancy is 107 years old with interval between 84 yrs and 131 yrs.

Look at the below data, Where the Life Expectancy is <= 49:

kable(data_df[LifeExp<=49,])
Country LifeExp InfantSurvival Under5Survival TBFree PropMD PropRN PersExp GovtExp TotExp LifeExp4.6 TotExp0.06 PropMD.TotExp
1 Afghanistan 42 0.835 0.743 0.99769 0.0002288 0.0005723 20 92 112 29305338 1.327251 0.0256302
5 Angola 41 0.846 0.740 0.99656 0.0000704 0.0011462 36 1620 1656 26230450 1.560068 0.1165824
27 Burkina Faso 47 0.878 0.796 0.99524 0.0000493 0.0004566 27 304 331 49164332 1.416412 0.0163183
28 Burundi 49 0.891 0.819 0.99286 0.0000245 0.0001649 3 10 13 59552770 1.166371 0.0003185
33 Central African Republic 48 0.886 0.826 0.99472 0.0000776 0.0003782 13 190 203 54163871 1.375466 0.0157528
34 Chad 46 0.876 0.791 0.99430 0.0000330 0.0002387 22 234 256 44533418 1.394744 0.0084480
47 Democratic Republic of the Congo 47 0.871 0.795 0.99355 0.0000961 0.0004747 5 66 71 49164332 1.291444 0.0068231
55 Equatorial Guinea 46 0.876 0.794 0.99596 0.0003085 0.0005464 211 6474 6685 44533418 1.696313 2.0621086
71 Guinea-Bissau 48 0.881 0.800 0.99687 0.0001142 0.0006513 10 90 100 54163871 1.318257 0.0114216
95 Lesotho 42 0.898 0.868 0.99487 0.0000446 0.0005629 41 437 478 29305338 1.447990 0.0213188
96 Liberia 44 0.843 0.765 0.99422 0.0000288 0.0002892 10 413 423 36297968 1.437409 0.0121824
104 Mali 46 0.881 0.783 0.99422 0.0000880 0.0006967 28 434 462 44533418 1.445035 0.0406560
122 Niger 42 0.852 0.747 0.99686 0.0000215 0.0002051 9 85 94 29305338 1.313372 0.0020210
123 Nigeria 48 0.901 0.809 0.99385 0.0002413 0.0014532 27 392 419 54163871 1.436590 0.1011106
152 Sierra Leone 40 0.841 0.731 0.99023 0.0000293 0.0004371 8 164 172 23414019 1.361858 0.0050396
162 Swaziland 42 0.888 0.836 0.98916 0.0001508 0.0060212 146 2256 2402 29305338 1.595271 0.3622072
189 Zambia 43 0.898 0.818 0.99432 0.0001081 0.0018818 36 595 631 32655392 1.472319 0.0681928
190 Zimbabwe 43 0.945 0.915 0.99403 0.0001577 0.0007074 21 324 345 32655392 1.419937 0.0544051 
kable(data_df[LifeExp == max(LifeExp),])
Country LifeExp InfantSurvival Under5Survival TBFree PropMD PropRN PersExp GovtExp TotExp LifeExp4.6 TotExp0.06 PropMD.TotExp
85 Japan 83 0.997 0.996 0.99971 0.002113 0.0094615 2936 159192 162128 672603658 2.053958 342.5844

The maximum life expectancy shows in Japan at 83, with Tot Exp of 162128.