enroll <- read.csv("enrollmentForecast.csv")
library(ggplot2)
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
ls(enroll)
## [1] "HGRAD" "INC" "ROLL" "UNEM" "YEAR"
head(enroll)
## YEAR ROLL UNEM HGRAD INC
## 1 1 5501 8.1 9552 1923
## 2 2 5945 7.0 9680 1961
## 3 3 6629 7.3 9731 1979
## 4 4 7556 7.5 11666 2030
## 5 5 8716 7.0 14675 2112
## 6 6 9369 6.4 15265 2192
ggplot(enroll, aes(x = ROLL, y = UNEM)) + geom_point()
ggplot(enroll, aes(x = ROLL, y = HGRAD)) + geom_point()
ggplot(enroll, aes(x = ROLL, y = INC)) + geom_point()
- The we build a linear model using the unemploment rate aand number of
spring high school students to predict fall enrollment.
roll1 = lm(ROLL ~ UNEM + HGRAD, data = enroll)
roll1
##
## Call:
## lm(formula = ROLL ~ UNEM + HGRAD, data = enroll)
##
## Coefficients:
## (Intercept) UNEM HGRAD
## -8255.7511 698.2681 0.9423
summary(roll1)
##
## 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(roll1)
## 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
plot(roll1, which = 1)
plot(roll1, which = 4)
hist(residuals(roll1))
fall_enroll <- lm(ROLL ~ UNEM + HGRAD, data = enroll)
newvar = 16081 - mean(enroll$HGRAD)
-8255.7511 + (698.2681 * newvar)
## [1] -320477.9
plot(fall_enroll, which = 1)
plot(fall_enroll, which = 4)
hist(residuals(fall_enroll))
- Use the predict functions of fall enrollment if the unmployment rate
is 9% and the size of the graduating class is 25,000.
predict_fall = data.frame(UNEM = .09, HGRAD = 25000)
predict(fall_enroll, predict_fall)
## 1
## 15364.01
Build a second model which inclusdes per capita income.
lm(ROLL ~ UNEM + HGRAD + INC, data = enroll)
##
## Call:
## lm(formula = ROLL ~ UNEM + HGRAD + INC, data = enroll)
##
## Coefficients:
## (Intercept) UNEM HGRAD INC
## -9153.2545 450.1245 0.4065 4.2749
fall_enroll2 = lm(ROLL ~ UNEM + HGRAD + INC, data = enroll)
class(fall_enroll2)
## [1] "lm"
str(fall_enroll2)
## List of 12
## $ coefficients : Named num [1:4] -9153.254 450.125 0.406 4.275
## ..- attr(*, "names")= chr [1:4] "(Intercept)" "UNEM" "HGRAD" "INC"
## $ residuals : Named num [1:29] -1095 -370.4 80.9 -86.7 -275.3 ...
## ..- attr(*, "names")= chr [1:29] "1" "2" "3" "4" ...
## $ effects : Named num [1:29] -68429.5 6738.5 14362.4 5793.8 -89.8 ...
## ..- attr(*, "names")= chr [1:29] "(Intercept)" "UNEM" "HGRAD" "INC" ...
## $ rank : int 4
## $ fitted.values: Named num [1:29] 6596 6315 6548 7643 8991 ...
## ..- attr(*, "names")= chr [1:29] "1" "2" "3" "4" ...
## $ assign : int [1:4] 0 1 2 3
## $ qr :List of 5
## ..$ qr : num [1:29, 1:4] -5.385 0.186 0.186 0.186 0.186 ...
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:29] "1" "2" "3" "4" ...
## .. .. ..$ : chr [1:4] "(Intercept)" "UNEM" "HGRAD" "INC"
## .. ..- attr(*, "assign")= int [1:4] 0 1 2 3
## ..$ qraux: num [1:4] 1.19 1.13 1.33 1.08
## ..$ pivot: int [1:4] 1 2 3 4
## ..$ tol : num 1e-07
## ..$ rank : int 4
## ..- attr(*, "class")= chr "qr"
## $ df.residual : int 25
## $ xlevels : Named list()
## $ call : language lm(formula = ROLL ~ UNEM + HGRAD + INC, data = enroll)
## $ terms :Classes 'terms', 'formula' language ROLL ~ UNEM + HGRAD + INC
## .. ..- attr(*, "variables")= language list(ROLL, UNEM, HGRAD, INC)
## .. ..- attr(*, "factors")= int [1:4, 1:3] 0 1 0 0 0 0 1 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:4] "ROLL" "UNEM" "HGRAD" "INC"
## .. .. .. ..$ : chr [1:3] "UNEM" "HGRAD" "INC"
## .. ..- attr(*, "term.labels")= chr [1:3] "UNEM" "HGRAD" "INC"
## .. ..- attr(*, "order")= int [1:3] 1 1 1
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(ROLL, UNEM, HGRAD, INC)
## .. ..- attr(*, "dataClasses")= Named chr [1:4] "numeric" "numeric" "numeric" "numeric"
## .. .. ..- attr(*, "names")= chr [1:4] "ROLL" "UNEM" "HGRAD" "INC"
## $ model :'data.frame': 29 obs. of 4 variables:
## ..$ ROLL : int [1:29] 5501 5945 6629 7556 8716 9369 9920 10167 11084 12504 ...
## ..$ UNEM : num [1:29] 8.1 7 7.3 7.5 7 6.4 6.5 6.4 6.3 7.7 ...
## ..$ HGRAD: int [1:29] 9552 9680 9731 11666 14675 15265 15484 15723 16501 16890 ...
## ..$ INC : int [1:29] 1923 1961 1979 2030 2112 2192 2235 2351 2411 2475 ...
## ..- attr(*, "terms")=Classes 'terms', 'formula' language ROLL ~ UNEM + HGRAD + INC
## .. .. ..- attr(*, "variables")= language list(ROLL, UNEM, HGRAD, INC)
## .. .. ..- attr(*, "factors")= int [1:4, 1:3] 0 1 0 0 0 0 1 0 0 0 ...
## .. .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. .. ..$ : chr [1:4] "ROLL" "UNEM" "HGRAD" "INC"
## .. .. .. .. ..$ : chr [1:3] "UNEM" "HGRAD" "INC"
## .. .. ..- attr(*, "term.labels")= chr [1:3] "UNEM" "HGRAD" "INC"
## .. .. ..- attr(*, "order")= int [1:3] 1 1 1
## .. .. ..- attr(*, "intercept")= int 1
## .. .. ..- attr(*, "response")= int 1
## .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. .. ..- attr(*, "predvars")= language list(ROLL, UNEM, HGRAD, INC)
## .. .. ..- attr(*, "dataClasses")= Named chr [1:4] "numeric" "numeric" "numeric" "numeric"
## .. .. .. ..- attr(*, "names")= chr [1:4] "ROLL" "UNEM" "HGRAD" "INC"
## - attr(*, "class")= chr "lm"
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
predict_fall2 = data.frame(UNEM = newvar, HGRAD = newvar, INC = newvar)
predict(fall_enroll2, predict_fall2)
## 1
## -212514.2