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.
# Load the dataset
health_data_url <- "https://raw.githubusercontent.com/NooriSelina/Data605/main/who.csv"
health_data <- read.csv(health_data_url)
# Display the first few rows of the dataset
head(health_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
# Scatterplot of Life expectancy vs. Total expenditures
plot(health_data$LifeExp ~ health_data$TotExp, xlab = 'Total Expenditures', ylab = 'Life Expectancy')
lm_original <- lm(LifeExp ~ TotExp, data = health_data)
summary(lm_original)
##
## Call:
## lm(formula = LifeExp ~ TotExp, data = health_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
The F-statistic tells us if our model fits the data better than a model with no predictors. In this case, our F-statistic is 65.26, which is high. The p-value associated with this statistic, 7.714e-14, is low. This means there’s a low chance that the relationship we’re seeing between life expectancy and total expenditures is due to random chance.
The R-squared value, 0.2577, gives us an idea of how well our model explains the variation in life expectancy. It tells us that approximately 25.77% of the variability in life expectancy can be explained by total expenditures on healthcare. While this isn’t a large proportion, it maysuggest that there is a meaningful relationship between the two variables.
health_data$LifeExp_transformed <- health_data$LifeExp ^ 4.6
health_data$TotExp_transformed <- health_data$TotExp ^ 0.06
# Plot
plot(health_data$LifeExp_transformed ~ health_data$TotExp_transformed, xlab = 'Total Expenditures Transformed', ylab = 'Life Expectancy Transformed')
# Simple linear regression
lm_transformed <- lm(LifeExp_transformed ~ TotExp_transformed, data = health_data)
summary(lm_transformed)
##
## Call:
## lm(formula = LifeExp_transformed ~ TotExp_transformed, data = health_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
The transformed model shows improvements over the original model. The F-statistic of 507.7, significantly outperforms the previous model in explaining the relationship. The p-value also supports this, indicating even stronger evidence against the null hypothesis. Moreover, the R-squared value of 0.7298 indicates that the transformed model explains around 72.98% of the variation in the data, a substantial enhancement over the original. In summary, the transformed model is “better”.
# Create formula for model
forecast_life_exp <- function(totexp_transformed) {
(-736527910 + (620060216 * totexp_transformed))^(1/4.6)
}
# Forecast for TotExp_transformed = 1.5
forecast_1 <- forecast_life_exp(1.5)
print("Forecast for TotExp_transformed = 1.5:")
## [1] "Forecast for TotExp_transformed = 1.5:"
print(forecast_1)
## [1] 63.31153
# Forecast for TotExp_transformed = 2.5
forecast_2 <- forecast_life_exp(2.5)
print("Forecast for TotExp_transformed = 2.5:")
## [1] "Forecast for TotExp_transformed = 2.5:"
print(forecast_2)
## [1] 86.50645
# Build the multiple regression model
lm_multiple <- lm(LifeExp ~ PropMD + TotExp + PropMD * TotExp, data = health_data)
# Interpret the results
summary(lm_multiple)
##
## Call:
## lm(formula = LifeExp ~ PropMD + TotExp + PropMD * TotExp, data = health_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
Based on the given information, the model is statistically significant (p < 0.05), with the independent variables collectively explaining approximately 35.74% of the variation in life expectancy. Additionally, the F-value suggests the model’s overall strength.
# Forecast LifeExp
forecast_life_exp <- predict(lm_multiple, newdata = data.frame(PropMD = 0.03, TotExp = 14))
# Print the forecast
print(forecast_life_exp)
## 1
## 107.696
This forecast appears unrealistic because it suggests a life expectancy of 107 years, which is considerably higher than typical life expectancies observed in the dataset. Thus, the forecast may not accurately reflect real-world scenarios.