head(College)
## Private Apps Accept Enroll Top10perc Top25perc
## Abilene Christian University Yes 1660 1232 721 23 52
## Adelphi University Yes 2186 1924 512 16 29
## Adrian College Yes 1428 1097 336 22 50
## Agnes Scott College Yes 417 349 137 60 89
## Alaska Pacific University Yes 193 146 55 16 44
## Albertson College Yes 587 479 158 38 62
## F.Undergrad P.Undergrad Outstate Room.Board Books
## Abilene Christian University 2885 537 7440 3300 450
## Adelphi University 2683 1227 12280 6450 750
## Adrian College 1036 99 11250 3750 400
## Agnes Scott College 510 63 12960 5450 450
## Alaska Pacific University 249 869 7560 4120 800
## Albertson College 678 41 13500 3335 500
## Personal PhD Terminal S.F.Ratio perc.alumni Expend
## Abilene Christian University 2200 70 78 18.1 12 7041
## Adelphi University 1500 29 30 12.2 16 10527
## Adrian College 1165 53 66 12.9 30 8735
## Agnes Scott College 875 92 97 7.7 37 19016
## Alaska Pacific University 1500 76 72 11.9 2 10922
## Albertson College 675 67 73 9.4 11 9727
## Grad.Rate
## Abilene Christian University 60
## Adelphi University 56
## Adrian College 54
## Agnes Scott College 59
## Alaska Pacific University 15
## Albertson College 55
str(College)
## 'data.frame': 777 obs. of 18 variables:
## $ Private : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ Apps : num 1660 2186 1428 417 193 ...
## $ Accept : num 1232 1924 1097 349 146 ...
## $ Enroll : num 721 512 336 137 55 158 103 489 227 172 ...
## $ Top10perc : num 23 16 22 60 16 38 17 37 30 21 ...
## $ Top25perc : num 52 29 50 89 44 62 45 68 63 44 ...
## $ F.Undergrad: num 2885 2683 1036 510 249 ...
## $ P.Undergrad: num 537 1227 99 63 869 ...
## $ Outstate : num 7440 12280 11250 12960 7560 ...
## $ Room.Board : num 3300 6450 3750 5450 4120 ...
## $ Books : num 450 750 400 450 800 500 500 450 300 660 ...
## $ Personal : num 2200 1500 1165 875 1500 ...
## $ PhD : num 70 29 53 92 76 67 90 89 79 40 ...
## $ Terminal : num 78 30 66 97 72 73 93 100 84 41 ...
## $ S.F.Ratio : num 18.1 12.2 12.9 7.7 11.9 9.4 11.5 13.7 11.3 11.5 ...
## $ perc.alumni: num 12 16 30 37 2 11 26 37 23 15 ...
## $ Expend : num 7041 10527 8735 19016 10922 ...
## $ Grad.Rate : num 60 56 54 59 15 55 63 73 80 52 ...
summary(College)
## Private Apps Accept Enroll Top10perc
## No :212 Min. : 81 Min. : 72 Min. : 35 Min. : 1.00
## Yes:565 1st Qu.: 776 1st Qu.: 604 1st Qu.: 242 1st Qu.:15.00
## Median : 1558 Median : 1110 Median : 434 Median :23.00
## Mean : 3002 Mean : 2019 Mean : 780 Mean :27.56
## 3rd Qu.: 3624 3rd Qu.: 2424 3rd Qu.: 902 3rd Qu.:35.00
## Max. :48094 Max. :26330 Max. :6392 Max. :96.00
## Top25perc F.Undergrad P.Undergrad Outstate
## Min. : 9.0 Min. : 139 Min. : 1.0 Min. : 2340
## 1st Qu.: 41.0 1st Qu.: 992 1st Qu.: 95.0 1st Qu.: 7320
## Median : 54.0 Median : 1707 Median : 353.0 Median : 9990
## Mean : 55.8 Mean : 3700 Mean : 855.3 Mean :10441
## 3rd Qu.: 69.0 3rd Qu.: 4005 3rd Qu.: 967.0 3rd Qu.:12925
## Max. :100.0 Max. :31643 Max. :21836.0 Max. :21700
## Room.Board Books Personal PhD
## Min. :1780 Min. : 96.0 Min. : 250 Min. : 8.00
## 1st Qu.:3597 1st Qu.: 470.0 1st Qu.: 850 1st Qu.: 62.00
## Median :4200 Median : 500.0 Median :1200 Median : 75.00
## Mean :4358 Mean : 549.4 Mean :1341 Mean : 72.66
## 3rd Qu.:5050 3rd Qu.: 600.0 3rd Qu.:1700 3rd Qu.: 85.00
## Max. :8124 Max. :2340.0 Max. :6800 Max. :103.00
## Terminal S.F.Ratio perc.alumni Expend
## Min. : 24.0 Min. : 2.50 Min. : 0.00 Min. : 3186
## 1st Qu.: 71.0 1st Qu.:11.50 1st Qu.:13.00 1st Qu.: 6751
## Median : 82.0 Median :13.60 Median :21.00 Median : 8377
## Mean : 79.7 Mean :14.09 Mean :22.74 Mean : 9660
## 3rd Qu.: 92.0 3rd Qu.:16.50 3rd Qu.:31.00 3rd Qu.:10830
## Max. :100.0 Max. :39.80 Max. :64.00 Max. :56233
## Grad.Rate
## Min. : 10.00
## 1st Qu.: 53.00
## Median : 65.00
## Mean : 65.46
## 3rd Qu.: 78.00
## Max. :118.00
par(mfrow=c(1,3))
barplot(table(College$Private), main="Private")
hist(College$Apps, main="Apps",freq=F)
lines(density(College$Apps))
hist(College$Accept, main="Accept",freq=F)
lines(density(College$Accept))
hist(College$Enroll, main="Enroll",freq=F)
lines(density(College$Enroll))
hist(College$Top10perc, main="Top10perc",freq=F)
lines(density(College$Top10perc))
hist(College$Top25perc, main="Top25perc",freq=F)
lines(density(College$Top25perc))
hist(College$F.Undergrad, main="F.Undergrad",freq=F)
lines(density(College$F.Undergrad))
hist(College$P.Undergrad, main="P.Undergrad",freq=F)
lines(density(College$P.Undergrad))
hist(College$Outstate, main="Outstate",freq=F)
lines(density(College$Outstate))
hist(College$Room.Board, main="Room.Board",freq=F)
lines(density(College$Books))
hist(College$Books, main="Books",freq=F)
lines(density(College$Books))
hist(College$Personal, main="Personal",freq=F)
lines(density(College$Personal))
hist(College$PhD, main="PhD",freq=F)
lines(density(College$PhD))
hist(College$Terminal, main="Terminal",freq=F)
lines(density(College$Terminal))
hist(College$S.F.Ratio, main="S.F.Ratio",freq=F)
lines(density(College$S.F.Ratio))
hist(College$perc.alumni, main="perc.alumni",freq=F)
lines(density(College$perc.alumni))
hist(College$Expend, main="Expend",freq=F)
lines(density(College$Expend))
hist(College$Grad.Rate, main="Grad.Rate",freq=F)
lines(density(College$Grad.Rate))
pairs(College[,-1])
corr_c<-cor(College[,-1])
round(corr_c,2)
## Apps Accept Enroll Top10perc Top25perc F.Undergrad P.Undergrad
## Apps 1.00 0.94 0.85 0.34 0.35 0.81 0.40
## Accept 0.94 1.00 0.91 0.19 0.25 0.87 0.44
## Enroll 0.85 0.91 1.00 0.18 0.23 0.96 0.51
## Top10perc 0.34 0.19 0.18 1.00 0.89 0.14 -0.11
## Top25perc 0.35 0.25 0.23 0.89 1.00 0.20 -0.05
## F.Undergrad 0.81 0.87 0.96 0.14 0.20 1.00 0.57
## P.Undergrad 0.40 0.44 0.51 -0.11 -0.05 0.57 1.00
## Outstate 0.05 -0.03 -0.16 0.56 0.49 -0.22 -0.25
## Room.Board 0.16 0.09 -0.04 0.37 0.33 -0.07 -0.06
## Books 0.13 0.11 0.11 0.12 0.12 0.12 0.08
## Personal 0.18 0.20 0.28 -0.09 -0.08 0.32 0.32
## PhD 0.39 0.36 0.33 0.53 0.55 0.32 0.15
## Terminal 0.37 0.34 0.31 0.49 0.52 0.30 0.14
## S.F.Ratio 0.10 0.18 0.24 -0.38 -0.29 0.28 0.23
## perc.alumni -0.09 -0.16 -0.18 0.46 0.42 -0.23 -0.28
## Expend 0.26 0.12 0.06 0.66 0.53 0.02 -0.08
## Grad.Rate 0.15 0.07 -0.02 0.49 0.48 -0.08 -0.26
## Outstate Room.Board Books Personal PhD Terminal S.F.Ratio
## Apps 0.05 0.16 0.13 0.18 0.39 0.37 0.10
## Accept -0.03 0.09 0.11 0.20 0.36 0.34 0.18
## Enroll -0.16 -0.04 0.11 0.28 0.33 0.31 0.24
## Top10perc 0.56 0.37 0.12 -0.09 0.53 0.49 -0.38
## Top25perc 0.49 0.33 0.12 -0.08 0.55 0.52 -0.29
## F.Undergrad -0.22 -0.07 0.12 0.32 0.32 0.30 0.28
## P.Undergrad -0.25 -0.06 0.08 0.32 0.15 0.14 0.23
## Outstate 1.00 0.65 0.04 -0.30 0.38 0.41 -0.55
## Room.Board 0.65 1.00 0.13 -0.20 0.33 0.37 -0.36
## Books 0.04 0.13 1.00 0.18 0.03 0.10 -0.03
## Personal -0.30 -0.20 0.18 1.00 -0.01 -0.03 0.14
## PhD 0.38 0.33 0.03 -0.01 1.00 0.85 -0.13
## Terminal 0.41 0.37 0.10 -0.03 0.85 1.00 -0.16
## S.F.Ratio -0.55 -0.36 -0.03 0.14 -0.13 -0.16 1.00
## perc.alumni 0.57 0.27 -0.04 -0.29 0.25 0.27 -0.40
## Expend 0.67 0.50 0.11 -0.10 0.43 0.44 -0.58
## Grad.Rate 0.57 0.42 0.00 -0.27 0.31 0.29 -0.31
## perc.alumni Expend Grad.Rate
## Apps -0.09 0.26 0.15
## Accept -0.16 0.12 0.07
## Enroll -0.18 0.06 -0.02
## Top10perc 0.46 0.66 0.49
## Top25perc 0.42 0.53 0.48
## F.Undergrad -0.23 0.02 -0.08
## P.Undergrad -0.28 -0.08 -0.26
## Outstate 0.57 0.67 0.57
## Room.Board 0.27 0.50 0.42
## Books -0.04 0.11 0.00
## Personal -0.29 -0.10 -0.27
## PhD 0.25 0.43 0.31
## Terminal 0.27 0.44 0.29
## S.F.Ratio -0.40 -0.58 -0.31
## perc.alumni 1.00 0.42 0.49
## Expend 0.42 1.00 0.39
## Grad.Rate 0.49 0.39 1.00
corrplot(corr_c, type='lower')
5. 수치형변수상관계수 1) 매우 강한 상관관계(절댓값이 0.8이상인 경우) -
Apps: Accept, Enroll, Top25perc, F.Undergrad - F. Undergrad: Accept,
Enroll - PhD: Terminal
boxplot(Apps ~ Private, data = College, main = "Apps & Private")
t.test(College$Apps~College$Private)
##
## Welch Two Sample t-test
##
## data: College$Apps by College$Private
## t = 9.7985, df = 244.49, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group No and group Yes is not equal to 0
## 95 percent confidence interval:
## 2997.758 4506.223
## sample estimates:
## mean in group No mean in group Yes
## 5729.920 1977.929
In this exercise, we will predict the number of applications received
using the the other variables in the College data set.
(a) Split the data set into a training set and a test set.
set.seed(1)
train_c<-sample(dim(College)[1], dim(College)[1]*0.7)
test_c<- (-train_c)
coll_train<-College[train_c,]
coll_test<-College[test_c,]
selec_for <- regsubsets(Apps ~ ., data = coll_train, nvmax = ncol(College)-1, method = "forward")
selec_sum <- summary(selec_for)
selec_sum
## Subset selection object
## Call: regsubsets.formula(Apps ~ ., data = coll_train, nvmax = ncol(College) -
## 1, method = "forward")
## 17 Variables (and intercept)
## Forced in Forced out
## PrivateYes FALSE FALSE
## Accept FALSE FALSE
## Enroll FALSE FALSE
## Top10perc FALSE FALSE
## Top25perc FALSE FALSE
## F.Undergrad FALSE FALSE
## P.Undergrad FALSE FALSE
## Outstate FALSE FALSE
## Room.Board FALSE FALSE
## Books FALSE FALSE
## Personal FALSE FALSE
## PhD FALSE FALSE
## Terminal FALSE FALSE
## S.F.Ratio FALSE FALSE
## perc.alumni FALSE FALSE
## Expend FALSE FALSE
## Grad.Rate FALSE FALSE
## 1 subsets of each size up to 17
## Selection Algorithm: forward
## PrivateYes Accept Enroll Top10perc Top25perc F.Undergrad P.Undergrad
## 1 ( 1 ) " " "*" " " " " " " " " " "
## 2 ( 1 ) " " "*" " " "*" " " " " " "
## 3 ( 1 ) " " "*" "*" "*" " " " " " "
## 4 ( 1 ) "*" "*" "*" "*" " " " " " "
## 5 ( 1 ) "*" "*" "*" "*" "*" " " " "
## 6 ( 1 ) "*" "*" "*" "*" "*" " " " "
## 7 ( 1 ) "*" "*" "*" "*" "*" " " " "
## 8 ( 1 ) "*" "*" "*" "*" "*" " " " "
## 9 ( 1 ) "*" "*" "*" "*" "*" " " " "
## 10 ( 1 ) "*" "*" "*" "*" "*" " " "*"
## 11 ( 1 ) "*" "*" "*" "*" "*" " " "*"
## 12 ( 1 ) "*" "*" "*" "*" "*" " " "*"
## 13 ( 1 ) "*" "*" "*" "*" "*" " " "*"
## 14 ( 1 ) "*" "*" "*" "*" "*" "*" "*"
## 15 ( 1 ) "*" "*" "*" "*" "*" "*" "*"
## 16 ( 1 ) "*" "*" "*" "*" "*" "*" "*"
## 17 ( 1 ) "*" "*" "*" "*" "*" "*" "*"
## Outstate Room.Board Books Personal PhD Terminal S.F.Ratio perc.alumni
## 1 ( 1 ) " " " " " " " " " " " " " " " "
## 2 ( 1 ) " " " " " " " " " " " " " " " "
## 3 ( 1 ) " " " " " " " " " " " " " " " "
## 4 ( 1 ) " " " " " " " " " " " " " " " "
## 5 ( 1 ) " " " " " " " " " " " " " " " "
## 6 ( 1 ) " " " " " " " " " " " " " " " "
## 7 ( 1 ) "*" " " " " " " " " " " " " " "
## 8 ( 1 ) "*" "*" " " " " " " " " " " " "
## 9 ( 1 ) "*" "*" " " " " "*" " " " " " "
## 10 ( 1 ) "*" "*" " " " " "*" " " " " " "
## 11 ( 1 ) "*" "*" " " " " "*" " " " " " "
## 12 ( 1 ) "*" "*" " " " " "*" " " "*" " "
## 13 ( 1 ) "*" "*" "*" " " "*" " " "*" " "
## 14 ( 1 ) "*" "*" "*" " " "*" " " "*" " "
## 15 ( 1 ) "*" "*" "*" " " "*" " " "*" "*"
## 16 ( 1 ) "*" "*" "*" "*" "*" " " "*" "*"
## 17 ( 1 ) "*" "*" "*" "*" "*" "*" "*" "*"
## Expend Grad.Rate
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) "*" " "
## 7 ( 1 ) "*" " "
## 8 ( 1 ) "*" " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" "*"
## 12 ( 1 ) "*" "*"
## 13 ( 1 ) "*" "*"
## 14 ( 1 ) "*" "*"
## 15 ( 1 ) "*" "*"
## 16 ( 1 ) "*" "*"
## 17 ( 1 ) "*" "*"
cat("Cp:",which.min(selec_sum$cp),"\n BIC",which.min(selec_sum$bic),"\n Adj R^2:",which.min(selec_sum$adjr2))
## Cp: 11
## BIC 9
## Adj R^2: 1
selec_plot <- function(stat, y.label, adj2 = FALSE) {
plot(stat, xlab = "Number of Variables", ylab = y.label, xaxt = "n", type = "l")
axis(side = 1, at = 1:length(stat))
if (adj2==FALSE) {
#가장 작은 값에서 한 단위의 표준오차 내의 값들의 집합
stat_1se <- min(stat) + (sd(stat) / sqrt(length(stat)))
sub <- which(stat< stat_1se)
}
else{
#가장 큰 값에서 한 단위의 표준오차 내의 값들의 집합
stat_1se <- max(stat) - (sd(stat) / sqrt(length(stat)))
sub <- which(stat > stat_1se)
}
#한 단위의 표준오차 내의 값을 가지는 것들 중 변수의 개수가 가장 작은 것 표시
abline(h = stat_1se, col = "red", lty = 2)
abline(v = sub[1], col = "green", lty = 2)
}
par(mfrow=c(1, 3))
selec_plot(selec_sum$cp, "Cp")
selec_plot(selec_sum$bic, "BIC")
selec_plot(selec_sum$adjr2, "Adjusted R2", adj2 = TRUE) # higher values are better
coef(selec_for,3)#추정계수
## (Intercept) Accept Enroll Top10perc
## -873.4114289 1.6781215 -0.5807793 35.2427218
plot(selec_for,scale="Cp")
plot(selec_for,scale="bic")
plot(selec_for,scale="adjr2")
coef(selec_for,1)
## (Intercept) Accept
## -46.334087 1.537243
m_c<-lm(Apps~.,data=College, subset=train_c)
summary(m_c)
##
## Call:
## lm(formula = Apps ~ ., data = College, subset = train_c)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5816.1 -451.6 -1.0 327.2 7445.9
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.377e+02 5.076e+02 -1.059 0.28995
## PrivateYes -5.045e+02 1.648e+02 -3.061 0.00232 **
## Accept 1.722e+00 4.763e-02 36.159 < 2e-16 ***
## Enroll -1.055e+00 2.437e-01 -4.329 1.80e-05 ***
## Top10perc 5.358e+01 6.440e+00 8.320 7.64e-16 ***
## Top25perc -1.614e+01 5.092e+00 -3.170 0.00161 **
## F.Undergrad 2.970e-02 4.399e-02 0.675 0.49976
## P.Undergrad 7.162e-02 3.649e-02 1.963 0.05019 .
## Outstate -8.841e-02 2.176e-02 -4.064 5.57e-05 ***
## Room.Board 1.630e-01 5.577e-02 2.923 0.00362 **
## Books 2.727e-01 2.723e-01 1.001 0.31715
## Personal -7.316e-03 7.283e-02 -0.100 0.92002
## PhD -9.676e+00 5.360e+00 -1.805 0.07161 .
## Terminal -3.781e-01 6.015e+00 -0.063 0.94990
## S.F.Ratio 1.627e+01 1.608e+01 1.012 0.31214
## perc.alumni 2.358e+00 4.853e+00 0.486 0.62722
## Expend 5.986e-02 1.337e-02 4.476 9.34e-06 ***
## Grad.Rate 7.158e+00 3.520e+00 2.034 0.04248 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1022 on 525 degrees of freedom
## Multiple R-squared: 0.9332, Adjusted R-squared: 0.9311
## F-statistic: 431.6 on 17 and 525 DF, p-value: < 2.2e-16
m_c.pred<-predict(m_c,coll_test)
m_c.error<-mean((m_c.pred-coll_test$Apps)^2)
m_c.error
## [1] 1261630
Polynomial Regression
Step Function
Natural Spline
Smoothing Spline
Local Regression
Generalized Additive Models(GAM)