MA717: Applied Regression and Experimental Data Analysis
Assignment template
options(repos = c(CRAN = "https://cran.rstudio.com"))1.1. Read “College.csv” file into R with following command and use dim() and head() to check if you read the data correct. You should report the number of observations and the number of variables. (5 \(\%\))
mydata<-read.csv("M:/AR lab/College.csv", header=T, stringsAsFactors=TRUE)
mydata <- read.csv("M:/AR lab/College.csv", header = TRUE, stringsAsFactors = TRUE)
dim(mydata)## [1] 775 17head(mydata)1.2. Use your registration number as random seed, generate a random subset of College data with sample size 700, name this new data as mynewdata. Use summary() to output the summarized information about mynewdata. Please report the number of private and public university and the number of Elite university and non-Elite university in this new data. (12 \(\%\))
set.seed(2404410)
mynewdata <- mydata[sample(1:nrow(mydata), 700), ]
summary(mynewdata)## Private Apps Accept Enroll
## No :194 Min. : 81.0 Min. : 72.0 Min. : 35.0
## Yes:506 1st Qu.: 783.8 1st Qu.: 612.8 1st Qu.: 242.0
## Median : 1557.5 Median : 1127.0 Median : 438.0
## Mean : 3016.1 Mean : 2044.2 Mean : 789.4
## 3rd Qu.: 3603.0 3rd Qu.: 2428.0 3rd Qu.: 893.8
## Max. :48094.0 Max. :26330.0 Max. :6392.0
## F.Undergrad P.Undergrad Outstate Room.Board
## Min. : 139.0 Min. : 1.00 Min. : 2340 Min. :1780
## 1st Qu.: 995.8 1st Qu.: 99.75 1st Qu.: 7396 1st Qu.:3600
## Median : 1738.0 Median : 363.50 Median : 9990 Median :4200
## Mean : 3742.2 Mean : 869.63 Mean :10450 Mean :4358
## 3rd Qu.: 4208.8 3rd Qu.: 984.75 3rd Qu.:12931 3rd Qu.:5016
## Max. :31643.0 Max. :21836.00 Max. :21700 Max. :8124
## Books Personal PhD Terminal
## Min. : 96.0 Min. : 250 Min. : 8.00 Min. : 24.00
## 1st Qu.: 451.5 1st Qu.: 850 1st Qu.: 62.00 1st Qu.: 71.00
## Median : 500.0 Median :1200 Median : 75.00 Median : 82.00
## Mean : 550.1 Mean :1342 Mean : 72.73 Mean : 79.81
## 3rd Qu.: 600.0 3rd Qu.:1682 3rd Qu.: 85.25 3rd Qu.: 92.00
## Max. :2340.0 Max. :6800 Max. :100.00 Max. :100.00
## S.F.Ratio perc.alumni Expend Grad.Rate Elite
## Min. : 2.50 Min. : 0.00 Min. : 3186 Min. : 10.00 No :634
## 1st Qu.:11.50 1st Qu.:13.00 1st Qu.: 6742 1st Qu.: 53.00 Yes: 66
## Median :13.60 Median :21.00 Median : 8418 Median : 65.00
## Mean :14.12 Mean :22.63 Mean : 9615 Mean : 65.24
## 3rd Qu.:16.50 3rd Qu.:31.00 3rd Qu.:10838 3rd Qu.: 77.00
## Max. :39.80 Max. :64.00 Max. :56233 Max. :100.00# Count Private/Public and Elite/Non-Elite universities
table(mynewdata$Private)##
## No Yes
## 194 506table(mynewdata$Elite)##
## No Yes
## 634 661.3. Use mynewdata, plot histogram plots of four variables “Outstate”, “Room.Board”, “Books” and “Personal”. Give each plot a suitable title and label for x axis and y axis. (8\(\%\))
install.packages("ggplot2")## Installing package into 'C:/Users/sp24604/AppData/Local/R/win-library/4.4'
## (as 'lib' is unspecified)## package 'ggplot2' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\sp24604\AppData\Local\Temp\Rtmps98eIC\downloaded_packageslibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 4.4.2hist_vars <- c("Outstate", "Room.Board", "Books", "Personal")
for (var in hist_vars) {
print(
ggplot(mynewdata, aes_string(x = var)) +
geom_histogram(binwidth = 1000, fill = "purple", color = "black", alpha = 0.7) +
labs(title = paste("Histogram of", var), x = var, y = "Frequency") +
theme_minimal()
)
}## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
2.1. Use mynewdata, do a linear regression fitting when outcome is “Grad.Rate” and predictors are “Private” and “Elite”. Show the R output and report what you have learned from this output (you need to discuss significance, adjusted R-squared and p-value of F-statistics). (6\(\%\)).
model1 <- lm(Grad.Rate ~ Private + Elite, data = mynewdata)
summary(model1)##
## Call:
## lm(formula = Grad.Rate ~ Private + Elite, data = mynewdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -51.775 -9.809 0.225 10.225 43.090
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 54.910 1.084 50.678 <2e-16 ***
## PrivateYes 11.865 1.270 9.346 <2e-16 ***
## EliteYes 18.625 1.944 9.578 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 15 on 697 degrees of freedom
## Multiple R-squared: 0.2162, Adjusted R-squared: 0.214
## F-statistic: 96.15 on 2 and 697 DF, p-value: < 2.2e-162.2. Use the linear regression fitting result in 2.1, calculate the confidence intervals for the coefficients. Also give the prediction interval of “Grad.Rate” for a new data with Private=“Yes” and Elite=“No”. (4\(\%\))
confint(model1)## 2.5 % 97.5 %
## (Intercept) 52.782484 57.03716
## PrivateYes 9.372864 14.35799
## EliteYes 14.806795 22.44226new_data <- data.frame(Private = "Yes", Elite = "No")
predict(model1, new_data, interval = "prediction")## fit lwr upr
## 1 66.77525 37.29607 96.254432.3 Use mynewdata, do a multiple linear regression fitting when outcome is “Grad.Rate”, all other variables as predictors. Show the R output and report what you have learned from this output (you need to discuss significance, adjusted R-squared and p-value of F-statistics). Is linear regression model in 2.3 better than linear regression in 2.1? Use ANOVA to justify your conclusion. (14%)
model2 <- lm(Grad.Rate ~ ., data = mynewdata)
summary(model2)##
## Call:
## lm(formula = Grad.Rate ~ ., data = mynewdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -45.994 -7.105 -0.398 7.306 42.302
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.220e+01 4.854e+00 6.634 6.64e-11 ***
## PrivateYes 4.208e+00 1.755e+00 2.398 0.016731 *
## Apps 1.524e-03 4.504e-04 3.384 0.000756 ***
## Accept -1.161e-03 8.706e-04 -1.334 0.182715
## Enroll 9.512e-04 2.351e-03 0.405 0.685903
## F.Undergrad -2.447e-05 4.095e-04 -0.060 0.952372
## P.Undergrad -1.795e-03 3.924e-04 -4.575 5.65e-06 ***
## Outstate 1.168e-03 2.404e-04 4.859 1.47e-06 ***
## Room.Board 1.673e-03 6.045e-04 2.768 0.005787 **
## Books 6.573e-04 2.972e-03 0.221 0.825061
## Personal -1.339e-03 7.839e-04 -1.708 0.088157 .
## PhD 1.867e-01 5.835e-02 3.200 0.001438 **
## Terminal -6.688e-02 6.455e-02 -1.036 0.300508
## S.F.Ratio -2.927e-02 1.616e-01 -0.181 0.856321
## perc.alumni 3.000e-01 5.071e-02 5.917 5.18e-09 ***
## Expend -4.566e-04 1.575e-04 -2.899 0.003869 **
## EliteYes 4.104e+00 2.098e+00 1.956 0.050907 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 12.56 on 683 degrees of freedom
## Multiple R-squared: 0.4614, Adjusted R-squared: 0.4488
## F-statistic: 36.57 on 16 and 683 DF, p-value: < 2.2e-16# Compare models using ANOVA
anova(model1, model2)2.4. Use the diagnostic plots to look at the fitting of multiple linear regression in 2.3. Please comment what you have seen from those plots. (7%)
par(mfrow = c(2, 2))
plot(model2)
2.5. Use mynewdata, do a variable selection to choose the best model. You should use plots to justify how do you choose your best model. Use the selected predictors of your best model with outcome “Grad.Rate”, do a linear regression fitting and plot the diagnostic plots for this fitting. You can use either exhaustive, or forward, or backward selection method. (14%)
library(MASS)
best_model <- stepAIC(model2, direction = "both")## Start: AIC=3559.5
## Grad.Rate ~ Private + Apps + Accept + Enroll + F.Undergrad +
## P.Undergrad + Outstate + Room.Board + Books + Personal +
## PhD + Terminal + S.F.Ratio + perc.alumni + Expend + Elite
##
## Df Sum of Sq RSS AIC
## - F.Undergrad 1 0.6 107744 3557.5
## - S.F.Ratio 1 5.2 107749 3557.5
## - Books 1 7.7 107751 3557.6
## - Enroll 1 25.8 107769 3557.7
## - Terminal 1 169.4 107913 3558.6
## - Accept 1 280.6 108024 3559.3
## <none> 107744 3559.5
## - Personal 1 460.0 108204 3560.5
## - Elite 1 603.4 108347 3561.4
## - Private 1 907.5 108651 3563.4
## - Room.Board 1 1209.0 108952 3565.3
## - Expend 1 1325.4 109069 3566.1
## - PhD 1 1615.3 109359 3567.9
## - Apps 1 1806.1 109550 3569.1
## - P.Undergrad 1 3302.3 111046 3578.6
## - Outstate 1 3724.1 111468 3581.3
## - perc.alumni 1 5523.2 113267 3592.5
##
## Step: AIC=3557.5
## Grad.Rate ~ Private + Apps + Accept + Enroll + P.Undergrad +
## Outstate + Room.Board + Books + Personal + PhD + Terminal +
## S.F.Ratio + perc.alumni + Expend + Elite
##
## Df Sum of Sq RSS AIC
## - S.F.Ratio 1 5.4 107749 3555.5
## - Books 1 7.7 107752 3555.6
## - Enroll 1 55.5 107800 3555.9
## - Terminal 1 171.2 107915 3556.6
## - Accept 1 280.2 108024 3557.3
## <none> 107744 3557.5
## - Personal 1 464.5 108209 3558.5
## - Elite 1 609.0 108353 3559.4
## + F.Undergrad 1 0.6 107744 3559.5
## - Private 1 924.4 108668 3561.5
## - Room.Board 1 1208.4 108953 3563.3
## - Expend 1 1326.2 109070 3564.1
## - PhD 1 1615.5 109360 3565.9
## - Apps 1 1813.2 109557 3567.2
## - P.Undergrad 1 3491.8 111236 3577.8
## - Outstate 1 3748.9 111493 3579.4
## - perc.alumni 1 5532.4 113277 3590.6
##
## Step: AIC=3555.54
## Grad.Rate ~ Private + Apps + Accept + Enroll + P.Undergrad +
## Outstate + Room.Board + Books + Personal + PhD + Terminal +
## perc.alumni + Expend + Elite
##
## Df Sum of Sq RSS AIC
## - Books 1 7.4 107757 3553.6
## - Enroll 1 54.1 107804 3553.9
## - Terminal 1 169.9 107919 3554.6
## - Accept 1 279.4 108029 3555.4
## <none> 107749 3555.5
## - Personal 1 460.0 108209 3556.5
## - Elite 1 607.4 108357 3557.5
## + S.F.Ratio 1 5.4 107744 3557.5
## + F.Undergrad 1 0.8 107749 3557.5
## - Private 1 973.2 108723 3559.8
## - Room.Board 1 1207.2 108957 3561.3
## - Expend 1 1474.4 109224 3563.1
## - PhD 1 1610.1 109360 3563.9
## - Apps 1 1809.3 109559 3565.2
## - P.Undergrad 1 3491.7 111241 3575.9
## - Outstate 1 3793.1 111543 3577.8
## - perc.alumni 1 5588.3 113338 3588.9
##
## Step: AIC=3553.59
## Grad.Rate ~ Private + Apps + Accept + Enroll + P.Undergrad +
## Outstate + Room.Board + Personal + PhD + Terminal + perc.alumni +
## Expend + Elite
##
## Df Sum of Sq RSS AIC
## - Enroll 1 55.9 107813 3551.9
## - Terminal 1 163.3 107920 3552.6
## - Accept 1 283.2 108040 3553.4
## <none> 107757 3553.6
## - Personal 1 453.5 108210 3554.5
## + Books 1 7.4 107749 3555.5
## - Elite 1 610.4 108367 3555.5
## + S.F.Ratio 1 5.2 107752 3555.6
## + F.Undergrad 1 0.7 107756 3555.6
## - Private 1 980.3 108737 3557.9
## - Room.Board 1 1245.6 109002 3559.6
## - Expend 1 1467.5 109224 3561.1
## - PhD 1 1615.7 109373 3562.0
## - Apps 1 1822.3 109579 3563.3
## - P.Undergrad 1 3490.2 111247 3573.9
## - Outstate 1 3785.7 111543 3575.8
## - perc.alumni 1 5580.9 113338 3586.9
##
## Step: AIC=3551.95
## Grad.Rate ~ Private + Apps + Accept + P.Undergrad + Outstate +
## Room.Board + Personal + PhD + Terminal + perc.alumni + Expend +
## Elite
##
## Df Sum of Sq RSS AIC
## - Terminal 1 160.6 107973 3551.0
## - Accept 1 243.3 108056 3551.5
## <none> 107813 3551.9
## - Personal 1 425.1 108238 3552.7
## + Enroll 1 55.9 107757 3553.6
## + F.Undergrad 1 29.9 107783 3553.8
## + Books 1 9.2 107804 3553.9
## + S.F.Ratio 1 3.7 107809 3553.9
## - Elite 1 677.4 108490 3554.3
## - Private 1 931.6 108744 3556.0
## - Room.Board 1 1200.1 109013 3557.7
## - Expend 1 1430.3 109243 3559.2
## - PhD 1 1631.6 109444 3560.5
## - Apps 1 1766.5 109579 3561.3
## - P.Undergrad 1 3467.1 111280 3572.1
## - Outstate 1 3731.1 111544 3573.8
## - perc.alumni 1 5847.0 113660 3586.9
##
## Step: AIC=3550.99
## Grad.Rate ~ Private + Apps + Accept + P.Undergrad + Outstate +
## Room.Board + Personal + PhD + perc.alumni + Expend + Elite
##
## Df Sum of Sq RSS AIC
## - Accept 1 262.8 108236 3550.7
## <none> 107973 3551.0
## - Personal 1 419.7 108393 3551.7
## + Terminal 1 160.6 107813 3551.9
## + Enroll 1 53.2 107920 3552.6
## + F.Undergrad 1 23.5 107950 3552.8
## + S.F.Ratio 1 2.8 107971 3553.0
## + Books 1 1.5 107972 3553.0
## - Elite 1 668.6 108642 3553.3
## - Private 1 1047.6 109021 3555.8
## - Room.Board 1 1114.9 109088 3556.2
## - Expend 1 1476.6 109450 3558.5
## - Apps 1 1814.0 109787 3560.7
## - PhD 1 2212.3 110186 3563.2
## - P.Undergrad 1 3526.3 111500 3571.5
## - Outstate 1 3645.6 111619 3572.2
## - perc.alumni 1 5717.3 113691 3585.1
##
## Step: AIC=3550.69
## Grad.Rate ~ Private + Apps + P.Undergrad + Outstate + Room.Board +
## Personal + PhD + perc.alumni + Expend + Elite
##
## Df Sum of Sq RSS AIC
## <none> 108236 3550.7
## + Accept 1 262.8 107973 3551.0
## - Personal 1 438.7 108675 3551.5
## + Terminal 1 180.2 108056 3551.5
## + Enroll 1 20.6 108216 3552.6
## + F.Undergrad 1 17.3 108219 3552.6
## + S.F.Ratio 1 4.1 108232 3552.7
## + Books 1 1.8 108234 3552.7
## - Elite 1 946.5 109183 3554.8
## - Private 1 1121.0 109357 3555.9
## - Room.Board 1 1186.4 109423 3556.3
## - Expend 1 1280.6 109517 3556.9
## - PhD 1 2091.7 110328 3562.1
## - Outstate 1 3455.1 111691 3570.7
## - P.Undergrad 1 3709.6 111946 3572.3
## - Apps 1 5733.5 113970 3584.8
## - perc.alumni 1 5919.2 114155 3586.0summary(best_model)##
## Call:
## lm(formula = Grad.Rate ~ Private + Apps + P.Undergrad + Outstate +
## Room.Board + Personal + PhD + perc.alumni + Expend + Elite,
## data = mynewdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -44.761 -7.149 -0.357 7.283 41.909
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 30.4461892 3.1653356 9.619 < 2e-16 ***
## PrivateYes 4.4829570 1.6781475 2.671 0.007733 **
## Apps 0.0009654 0.0001598 6.041 2.50e-09 ***
## P.Undergrad -0.0018027 0.0003710 -4.859 1.46e-06 ***
## Outstate 0.0010958 0.0002337 4.690 3.30e-06 ***
## Room.Board 0.0016202 0.0005896 2.748 0.006151 **
## Personal -0.0012744 0.0007626 -1.671 0.095158 .
## PhD 0.1366526 0.0374494 3.649 0.000283 ***
## perc.alumni 0.3043903 0.0495880 6.138 1.41e-09 ***
## Expend -0.0004033 0.0001413 -2.855 0.004431 **
## EliteYes 4.9189636 2.0040048 2.455 0.014352 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 12.53 on 689 degrees of freedom
## Multiple R-squared: 0.459, Adjusted R-squared: 0.4511
## F-statistic: 58.45 on 10 and 689 DF, p-value: < 2.2e-16par(mfrow = c(2, 2))
plot(best_model)
Use mynewdata, discuss and perform any step(s) that you think that can improve the fitting in Task 2. You need to illustrate your work by using the R codes, output and discussion.
improved_model <- lm(Grad.Rate ~ Private * Elite + Outstate + Room.Board + Books + Personal, data = mynewdata)
summary(improved_model)##
## Call:
## lm(formula = Grad.Rate ~ Private * Elite + Outstate + Room.Board +
## Books + Personal, data = mynewdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -46.383 -8.124 0.128 7.950 43.263
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.129e+01 2.911e+00 14.185 < 2e-16 ***
## PrivateYes 1.552e+00 1.436e+00 1.081 0.27990
## EliteYes 1.640e+01 4.041e+00 4.058 5.51e-05 ***
## Outstate 1.880e-03 2.029e-04 9.265 < 2e-16 ***
## Room.Board 1.306e-03 6.131e-04 2.131 0.03345 *
## Books -8.122e-04 3.120e-03 -0.260 0.79470
## Personal -2.109e-03 8.053e-04 -2.619 0.00901 **
## PrivateYes:EliteYes -1.005e+01 4.484e+00 -2.241 0.02535 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 13.42 on 692 degrees of freedom
## Multiple R-squared: 0.3767, Adjusted R-squared: 0.3704
## F-statistic: 59.74 on 7 and 692 DF, p-value: < 2.2e-16par(mfrow = c(2, 2))
plot(improved_model)
write.csv(summary(mynewdata), "mynewdata_summary.csv")