Module10

Read the data

enroll <- read.csv("enrollmentForecast.csv")
library(ggplot2)

str(enroll)

'data.frame':   29 obs. of  5 variables:
 $ YEAR : int  1 2 3 4 5 6 7 8 9 10 ...
 $ ROLL : int  5501 5945 6629 7556 8716 9369 9920 10167 11084 12504 ...
 $ UNEM : num  8.1 7 7.3 7.5 7 6.4 6.5 6.4 6.3 7.7 ...
 $ HGRAD: int  9552 9680 9731 11666 14675 15265 15484 15723 16501 16890 ...
 $ INC  : int  1923 1961 1979 2030 2112 2192 2235 2351 2411 2475 ...

summary(enroll)

      YEAR         ROLL            UNEM            HGRAD            INC      
 Min.   : 1   Min.   : 5501   Min.   : 5.700   Min.   : 9552   Min.   :1923  
 1st Qu.: 8   1st Qu.:10167   1st Qu.: 7.000   1st Qu.:15723   1st Qu.:2351  
 Median :15   Median :14395   Median : 7.500   Median :17203   Median :2863  
 Mean   :15   Mean   :12707   Mean   : 7.717   Mean   :16528   Mean   :2729  
 3rd Qu.:22   3rd Qu.:14969   3rd Qu.: 8.200   3rd Qu.:18266   3rd Qu.:3127  
 Max.   :29   Max.   :16081   Max.   :10.100   Max.   :19800   Max.   :3345  

Make scatterplots of ROLL against the other variables

ggplot(enroll, aes(x = UNEM, y = ROLL)) + geom_point() + ggtitle("Enrollment vs Unemployment")

ggplot(enroll, aes(x = HGRAD, y = ROLL)) + geom_point() + ggtitle("Enrollment vs High School Graduates")

ggplot(enroll, aes(x = INC, y = ROLL)) + geom_point() + ggtitle("Enrollment vs Income")

Build a linear model using UNEM and number of spring HGRAD to predict the fall enrollment

model1 = lm(ROLL ~ UNEM + HGRAD, data = enroll)

Investigate the model by using summary() & anova()

summary(model1)

Call:
lm(formula = ROLL ~ UNEM + HGRAD, data = enroll)

Residuals:
    Min      1Q  Median      3Q     Max 
-2102.2  -861.6  -349.4   374.5  3603.5 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -8.256e+03  2.052e+03  -4.023  0.00044 ***
UNEM         6.983e+02  2.244e+02   3.111  0.00449 ** 
HGRAD        9.423e-01  8.613e-02  10.941 3.16e-11 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1313 on 26 degrees of freedom
Multiple R-squared:  0.8489,    Adjusted R-squared:  0.8373 
F-statistic: 73.03 on 2 and 26 DF,  p-value: 2.144e-11

anova(model1)

Analysis of Variance Table

Response: ROLL
          Df    Sum Sq   Mean Sq F value    Pr(>F)    
UNEM       1  45407767  45407767  26.349 2.366e-05 ***
HGRAD      1 206279143 206279143 119.701 3.157e-11 ***
Residuals 26  44805568   1723291                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Which variable is the most closely related to enrollment?

The analysis indicates that High School Graduation Rate (HGRAD) is the variable most strongly associated with enrollment (ROLL). HGRAD accounts for the largest sum of squares, has the highest F-value (119.701), and shows a highly significant p-value (3.16e-11), indicating a very strong statistical relationship.

Make a residual plot and check for any bias in the model

plot(model1, which = 1)

hist(residuals(model1))

The residuals vs. fitted plot shows a curved pattern, suggesting that the model may not fully capture the relationship between the variables. Additionally, the residuals histogram shows many residuals between -1000 and 0 with slight right skewness, indicating an imbalance. Overall, these results suggest that the model may be slightly biased.

Estimate the expected fall enrollment (if UNEM is 9% & spring HGRAD is 25,000)

newdata = data.frame(UNEM = 9, HGRAD = 25000)
predict(model1, newdata)

       1 
21585.58 

Build a second model which includes per capita income (INC)

model2 = lm(ROLL ~ UNEM + HGRAD + INC, data = enroll)
summary(model2)

Call:
lm(formula = ROLL ~ UNEM + HGRAD + INC, data = enroll)

Residuals:
     Min       1Q   Median       3Q      Max 
-1148.84  -489.71    -1.88   387.40  1425.75 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -9.153e+03  1.053e+03  -8.691 5.02e-09 ***
UNEM         4.501e+02  1.182e+02   3.809 0.000807 ***
HGRAD        4.065e-01  7.602e-02   5.347 1.52e-05 ***
INC          4.275e+00  4.947e-01   8.642 5.59e-09 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 670.4 on 25 degrees of freedom
Multiple R-squared:  0.9621,    Adjusted R-squared:  0.9576 
F-statistic: 211.5 on 3 and 25 DF,  p-value: < 2.2e-16

Compare the two models with anova()

anova(model1, model2)

Analysis of Variance Table

Model 1: ROLL ~ UNEM + HGRAD
Model 2: ROLL ~ UNEM + HGRAD + INC
  Res.Df      RSS Df Sum of Sq     F    Pr(>F)    
1     26 44805568                                 
2     25 11237313  1  33568255 74.68 5.594e-09 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Model 2 is a significant improvement because the addition of the INC variable substantially reduces the residual sum of squares and yields a highly significant p-value of less than 0.001 in the ANOVA test. This indicates that INC explains additional variance in enrollment beyond UNEM and HGRAD.