Overview

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.

#Loading data
data <- read.csv("C:/Users/aleja/Downloads/who.csv")

#First few rows of dataset
head(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
#Structure of dataset
str(data)
## 'data.frame':    190 obs. of  10 variables:
##  $ Country       : chr  "Afghanistan" "Albania" "Algeria" "Andorra" ...
##  $ 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 ...

1. Scatterplot

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.

#Scatterplot of LifeExp~TotExp
plot(data$TotExp, data$LifeExp, xlab = "Total Expenditures", ylab = "Life Expectancy")

#Simple Linear Regression
model <- lm(LifeExp ~ TotExp, data = data)

#Summary of the regression model
summary(model)
## 
## Call:
## lm(formula = LifeExp ~ TotExp, data = 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

We can see that the p-value associated with the F-statistic is highly significant (p-value: 7.714e-14), indicating that the overall regression model is statistically significant. The R-squared value is 0.2577, suggesting that approximately 25.77% of the variance in Life Expectancy is explained by Total Expenditures.

2. Life expectancy

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 r 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?”

#Transform variables
data$LifeExp_transformed <- data$LifeExp^4.6
data$TotExp_transformed <- data$TotExp^0.06

#Plotting the transformed variables
plot(data$TotExp_transformed, data$LifeExp_transformed, 
     xlab = "TotExp^.06", ylab = "LifeExp^4.6",
     main = "Life Expectancy vs Total Expenditures (Transformed)")

#Simple regression with transformed variables
model_transformed <- lm(LifeExp_transformed ~ TotExp_transformed, data = data)

#Summary of the transformed model
summary(model_transformed)
## 
## Call:
## lm(formula = LifeExp_transformed ~ TotExp_transformed, data = 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_transformed  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

Comparing Models: The transformed model has a higher R-squared value (0.7298) compared to the original model (0.2577), indicating that it explains a larger proportion of the variance in the dependent variable. Therefore, the transformed model appears to be better at predicting life expectancy based on total expenditures.

3. Life expectancy forecast

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

#Given coefficients from the regression output
intercept <- -736527910
coefficient <- 620060216

#Forecast for TotExp^.06 = 1.5
totexp_1 <- 1.5
lifeexp_1 <- intercept + coefficient * totexp_1
lifeexp_1
## [1] 193562414
#Forecast for TotExp^.06 = 2.5
totexp_2 <- 2.5
lifeexp_2 <- intercept + coefficient * totexp_2
lifeexp_2
## [1] 813622630

4. Multiple regression model

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

LifeExp = b0+b1 x PropMd + b2 x TotExp +b3 x PropMD x TotExp

#Fitting the multiple regression model
model <- lm(LifeExp ~ PropMD + TotExp + PropMD * TotExp, data = data)

#Summary of the model
summary(model)
## 
## Call:
## lm(formula = LifeExp ~ PropMD + TotExp + 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 ***
## 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

The model appears to be statistically significant based on the F-statistic, and it explains a moderate proportion of the variance in life expectancy. However, there may be other variables or factors not included in the model that could further improve its predictive power.

5. Forecast

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

#Coefficients from the multiple regression model
b0 <- 62.77
b1 <- 1497
b2 <- 0.00007233
b3 <- -0.006026

#Given values
PropMD <- 0.03
TotExp <- 14

#Forecast LifeExp
LifeExp <- b0 + b1 * PropMD + b2 * TotExp + b3 * PropMD * TotExp

#Printing the forecasted LifeExp
print(LifeExp)
## [1] 107.6785
LS0tDQp0aXRsZTogIkRhdGEgNjA1IEFzc2lnbm1lbnQgMTIiDQphdXRob3I6ICJMYXVyYSBCIg0KZGF0ZTogImByIFN5cy5EYXRlKClgIg0Kb3V0cHV0OiBvcGVuaW50cm86OmxhYl9yZXBvcnQNCi0tLQ0KDQoNCiMjIyBPdmVydmlldw0KDQpUaGUgYXR0YWNoZWQgd2hvLmNzdiBkYXRhc2V0IGNvbnRhaW5zIHJlYWwtd29ybGQgZGF0YSBmcm9tIDIwMDguIFRoZSB2YXJpYWJsZXMgaW5jbHVkZWQgZm9sbG93Lg0KDQpDb3VudHJ5OiBuYW1lIG9mIHRoZSBjb3VudHJ5DQpMaWZlRXhwOiBhdmVyYWdlIGxpZmUgZXhwZWN0YW5jeSBmb3IgdGhlIGNvdW50cnkgaW4geWVhcnMNCkluZmFudFN1cnZpdmFsOiBwcm9wb3J0aW9uIG9mIHRob3NlIHN1cnZpdmluZyB0byBvbmUgeWVhciBvciBtb3JlDQpVbmRlcjVTdXJ2aXZhbDogcHJvcG9ydGlvbiBvZiB0aG9zZSBzdXJ2aXZpbmcgdG8gZml2ZSB5ZWFycyBvciBtb3JlDQpUQkZyZWU6IHByb3BvcnRpb24gb2YgdGhlIHBvcHVsYXRpb24gd2l0aG91dCBUQi4NClByb3BNRDogcHJvcG9ydGlvbiBvZiB0aGUgcG9wdWxhdGlvbiB3aG8gYXJlIE1Ecw0KUHJvcFJOOiBwcm9wb3J0aW9uIG9mIHRoZSBwb3B1bGF0aW9uIHdobyBhcmUgUk5zDQpQZXJzRXhwOiBtZWFuIHBlcnNvbmFsIGV4cGVuZGl0dXJlcyBvbiBoZWFsdGhjYXJlIGluIFVTIGRvbGxhcnMgYXQgYXZlcmFnZSBleGNoYW5nZSByYXRlDQpHb3Z0RXhwOiBtZWFuIGdvdmVybm1lbnQgZXhwZW5kaXR1cmVzIHBlciBjYXBpdGEgb24gaGVhbHRoY2FyZSwgVVMgZG9sbGFycyBhdCBhdmVyYWdlIGV4Y2hhbmdlIHJhdGUNClRvdEV4cDogc3VtIG9mIHBlcnNvbmFsIGFuZCBnb3Zlcm5tZW50IGV4cGVuZGl0dXJlcy4NCg0KYGBge3IgbG9hZC1wYWNrYWdlcywgbWVzc2FnZT1GQUxTRX0NCiNMb2FkaW5nIGRhdGENCmRhdGEgPC0gcmVhZC5jc3YoIkM6L1VzZXJzL2FsZWphL0Rvd25sb2Fkcy93aG8uY3N2IikNCg0KI0ZpcnN0IGZldyByb3dzIG9mIGRhdGFzZXQNCmhlYWQoZGF0YSkNCg0KI1N0cnVjdHVyZSBvZiBkYXRhc2V0DQpzdHIoZGF0YSkNCg0KYGBgDQoNCiMjIyAxLiBTY2F0dGVycGxvdA0KDQpQcm92aWRlIGEgc2NhdHRlcnBsb3Qgb2YgTGlmZUV4cH5Ub3RFeHAsIGFuZCBydW4gc2ltcGxlIGxpbmVhciByZWdyZXNzaW9uLiBEbyBub3QgdHJhbnNmb3JtIHRoZQ0KdmFyaWFibGVzLiBQcm92aWRlIGFuZCBpbnRlcnByZXQgdGhlIEYgc3RhdGlzdGljcywgUl4yLCBzdGFuZGFyZCBlcnJvcixhbmQgcC12YWx1ZXMgb25seS4gRGlzY3Vzcw0Kd2hldGhlciB0aGUgYXNzdW1wdGlvbnMgb2Ygc2ltcGxlIGxpbmVhciByZWdyZXNzaW9uIG1ldC4NCg0KDQoNCmBgYHtyfQ0KI1NjYXR0ZXJwbG90IG9mIExpZmVFeHB+VG90RXhwDQpwbG90KGRhdGEkVG90RXhwLCBkYXRhJExpZmVFeHAsIHhsYWIgPSAiVG90YWwgRXhwZW5kaXR1cmVzIiwgeWxhYiA9ICJMaWZlIEV4cGVjdGFuY3kiKQ0KDQojU2ltcGxlIExpbmVhciBSZWdyZXNzaW9uDQptb2RlbCA8LSBsbShMaWZlRXhwIH4gVG90RXhwLCBkYXRhID0gZGF0YSkNCg0KI1N1bW1hcnkgb2YgdGhlIHJlZ3Jlc3Npb24gbW9kZWwNCnN1bW1hcnkobW9kZWwpDQoNCmBgYA0KDQpXZSBjYW4gc2VlIHRoYXQgdGhlIHAtdmFsdWUgYXNzb2NpYXRlZCB3aXRoIHRoZSBGLXN0YXRpc3RpYyBpcyBoaWdobHkgc2lnbmlmaWNhbnQgKHAtdmFsdWU6IDcuNzE0ZS0xNCksIGluZGljYXRpbmcgdGhhdCB0aGUgb3ZlcmFsbCByZWdyZXNzaW9uIG1vZGVsIGlzIHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQuIFRoZSBSLXNxdWFyZWQgdmFsdWUgaXMgMC4yNTc3LCBzdWdnZXN0aW5nIHRoYXQgYXBwcm94aW1hdGVseSAyNS43NyUgb2YgdGhlIHZhcmlhbmNlIGluIExpZmUgRXhwZWN0YW5jeSBpcyBleHBsYWluZWQgYnkgVG90YWwgRXhwZW5kaXR1cmVzLg0KDQoNCiMjIyAyLiBMaWZlIGV4cGVjdGFuY3kNCg0KUmFpc2UgbGlmZSBleHBlY3RhbmN5IHRvIHRoZSA0LjYgcG93ZXIgKGkuZS4sIExpZmVFeHBeNC42KS4gUmFpc2UgdG90YWwgZXhwZW5kaXR1cmVzIHRvIHRoZSAwLjA2DQpwb3dlciAobmVhcmx5IGEgbG9nIHRyYW5zZm9ybSwgVG90RXhwXi4wNikuIFBsb3QgTGlmZUV4cF40LjYgYXMgYSBmdW5jdGlvbiBvZiBUb3RFeHBeLjA2LCBhbmQgcg0KcmUtcnVuIHRoZSBzaW1wbGUgcmVncmVzc2lvbiBtb2RlbCB1c2luZyB0aGUgdHJhbnNmb3JtZWQgdmFyaWFibGVzLiBQcm92aWRlIGFuZCBpbnRlcnByZXQgdGhlIEYNCnN0YXRpc3RpY3MsIFJeMiwgc3RhbmRhcmQgZXJyb3IsIGFuZCBwLXZhbHVlcy4gV2hpY2ggbW9kZWwgaXMgImJldHRlcj8iDQoNCmBgYHtyfQ0KI1RyYW5zZm9ybSB2YXJpYWJsZXMNCmRhdGEkTGlmZUV4cF90cmFuc2Zvcm1lZCA8LSBkYXRhJExpZmVFeHBeNC42DQpkYXRhJFRvdEV4cF90cmFuc2Zvcm1lZCA8LSBkYXRhJFRvdEV4cF4wLjA2DQoNCiNQbG90dGluZyB0aGUgdHJhbnNmb3JtZWQgdmFyaWFibGVzDQpwbG90KGRhdGEkVG90RXhwX3RyYW5zZm9ybWVkLCBkYXRhJExpZmVFeHBfdHJhbnNmb3JtZWQsIA0KICAgICB4bGFiID0gIlRvdEV4cF4uMDYiLCB5bGFiID0gIkxpZmVFeHBeNC42IiwNCiAgICAgbWFpbiA9ICJMaWZlIEV4cGVjdGFuY3kgdnMgVG90YWwgRXhwZW5kaXR1cmVzIChUcmFuc2Zvcm1lZCkiKQ0KDQojU2ltcGxlIHJlZ3Jlc3Npb24gd2l0aCB0cmFuc2Zvcm1lZCB2YXJpYWJsZXMNCm1vZGVsX3RyYW5zZm9ybWVkIDwtIGxtKExpZmVFeHBfdHJhbnNmb3JtZWQgfiBUb3RFeHBfdHJhbnNmb3JtZWQsIGRhdGEgPSBkYXRhKQ0KDQojU3VtbWFyeSBvZiB0aGUgdHJhbnNmb3JtZWQgbW9kZWwNCnN1bW1hcnkobW9kZWxfdHJhbnNmb3JtZWQpDQoNCmBgYA0KDQpDb21wYXJpbmcgTW9kZWxzOg0KVGhlIHRyYW5zZm9ybWVkIG1vZGVsIGhhcyBhIGhpZ2hlciBSLXNxdWFyZWQgdmFsdWUgKDAuNzI5OCkgY29tcGFyZWQgdG8gdGhlIG9yaWdpbmFsIG1vZGVsICgwLjI1NzcpLCBpbmRpY2F0aW5nIHRoYXQgaXQgZXhwbGFpbnMgYSBsYXJnZXIgcHJvcG9ydGlvbiBvZiB0aGUgdmFyaWFuY2UgaW4gdGhlIGRlcGVuZGVudCB2YXJpYWJsZS4gVGhlcmVmb3JlLCB0aGUgdHJhbnNmb3JtZWQgbW9kZWwgYXBwZWFycyB0byBiZSBiZXR0ZXIgYXQgcHJlZGljdGluZyBsaWZlIGV4cGVjdGFuY3kgYmFzZWQgb24gdG90YWwgZXhwZW5kaXR1cmVzLg0KDQoNCiMjIyAzLiBMaWZlIGV4cGVjdGFuY3kgZm9yZWNhc3QNCg0KVXNpbmcgdGhlIHJlc3VsdHMgZnJvbSAzLCBmb3JlY2FzdCBsaWZlIGV4cGVjdGFuY3kgd2hlbiBUb3RFeHBeLjA2ID0xLjUuIFRoZW4gZm9yZWNhc3QgbGlmZQ0KZXhwZWN0YW5jeSB3aGVuIFRvdEV4cF4uMDY9Mi41LiANCg0KDQpgYGB7cn0NCiNHaXZlbiBjb2VmZmljaWVudHMgZnJvbSB0aGUgcmVncmVzc2lvbiBvdXRwdXQNCmludGVyY2VwdCA8LSAtNzM2NTI3OTEwDQpjb2VmZmljaWVudCA8LSA2MjAwNjAyMTYNCg0KI0ZvcmVjYXN0IGZvciBUb3RFeHBeLjA2ID0gMS41DQp0b3RleHBfMSA8LSAxLjUNCmxpZmVleHBfMSA8LSBpbnRlcmNlcHQgKyBjb2VmZmljaWVudCAqIHRvdGV4cF8xDQpsaWZlZXhwXzENCg0KI0ZvcmVjYXN0IGZvciBUb3RFeHBeLjA2ID0gMi41DQp0b3RleHBfMiA8LSAyLjUNCmxpZmVleHBfMiA8LSBpbnRlcmNlcHQgKyBjb2VmZmljaWVudCAqIHRvdGV4cF8yDQpsaWZlZXhwXzINCg0KYGBgDQoNCiMjIyA0LiBNdWx0aXBsZSByZWdyZXNzaW9uIG1vZGVsDQoNCkJ1aWxkIHRoZSBmb2xsb3dpbmcgbXVsdGlwbGUgcmVncmVzc2lvbiBtb2RlbCBhbmQgaW50ZXJwcmV0IHRoZSBGIFN0YXRpc3RpY3MsIFJeMiwgc3RhbmRhcmQgZXJyb3IsDQphbmQgcC12YWx1ZXMuIEhvdyBnb29kIGlzIHRoZSBtb2RlbD8NCg0KTGlmZUV4cCA9IGIwK2IxIHggUHJvcE1kICsgYjIgeCBUb3RFeHAgK2IzIHggUHJvcE1EIHggVG90RXhwDQoNCmBgYHtyfQ0KI0ZpdHRpbmcgdGhlIG11bHRpcGxlIHJlZ3Jlc3Npb24gbW9kZWwNCm1vZGVsIDwtIGxtKExpZmVFeHAgfiBQcm9wTUQgKyBUb3RFeHAgKyBQcm9wTUQgKiBUb3RFeHAsIGRhdGEgPSBkYXRhKQ0KDQojU3VtbWFyeSBvZiB0aGUgbW9kZWwNCnN1bW1hcnkobW9kZWwpDQoNCmBgYA0KDQpUaGUgbW9kZWwgYXBwZWFycyB0byBiZSBzdGF0aXN0aWNhbGx5IHNpZ25pZmljYW50IGJhc2VkIG9uIHRoZSBGLXN0YXRpc3RpYywgYW5kIGl0IGV4cGxhaW5zIGEgbW9kZXJhdGUgcHJvcG9ydGlvbiBvZiB0aGUgdmFyaWFuY2UgaW4gbGlmZSBleHBlY3RhbmN5LiBIb3dldmVyLCB0aGVyZSBtYXkgYmUgb3RoZXIgdmFyaWFibGVzIG9yIGZhY3RvcnMgbm90IGluY2x1ZGVkIGluIHRoZSBtb2RlbCB0aGF0IGNvdWxkIGZ1cnRoZXIgaW1wcm92ZSBpdHMgcHJlZGljdGl2ZSBwb3dlci4NCg0KDQojIyMgNS4gRm9yZWNhc3QNCg0KRm9yZWNhc3QgTGlmZUV4cCB3aGVuIFByb3BNRD0uMDMgYW5kIFRvdEV4cCA9IDE0LiBEb2VzIHRoaXMgZm9yZWNhc3Qgc2VlbSByZWFsaXN0aWM/IFdoeSBvciB3aHkgbm90Pw0KDQoNCmBgYHtyfQ0KI0NvZWZmaWNpZW50cyBmcm9tIHRoZSBtdWx0aXBsZSByZWdyZXNzaW9uIG1vZGVsDQpiMCA8LSA2Mi43Nw0KYjEgPC0gMTQ5Nw0KYjIgPC0gMC4wMDAwNzIzMw0KYjMgPC0gLTAuMDA2MDI2DQoNCiNHaXZlbiB2YWx1ZXMNClByb3BNRCA8LSAwLjAzDQpUb3RFeHAgPC0gMTQNCg0KI0ZvcmVjYXN0IExpZmVFeHANCkxpZmVFeHAgPC0gYjAgKyBiMSAqIFByb3BNRCArIGIyICogVG90RXhwICsgYjMgKiBQcm9wTUQgKiBUb3RFeHANCg0KI1ByaW50aW5nIHRoZSBmb3JlY2FzdGVkIExpZmVFeHANCnByaW50KExpZmVFeHApDQoNCmBgYA0KDQo=