Nearest Neighborhood Algorithm의 장점
- 알고리듬이 매우 간단하여 이해하기 쉽다.
- 관측된 데이터셋에 대해 분포를 가정할 필요가 없다.
- 훈련하는 동안 계산적 비용이 거의 없다.
Nearest Neighborhood Algorithm의 단점
- 범주형 예측 변수를 다룰 수 없다.
- Dummy 또는 One-hot Encoding 변환 후 사용할 수 있다.
- 데이터셋의 크기가 큰 경우, 새로운 Case와 다른 Case들과의 거리 계산에 시간이 많이 걸릴 수 있다.
- 이상치와 노이즈가 있는 경우, 예측에 큰 영향을 미친다.
- 고차원의 경우, 성능이 좋지 않다.
- 차원이 높아질수록 Case간 거리 차이가 거의 없는 것처럼 보여, 가장 가까운 거리를 찾는 것이 어렵다.
실습 자료 : 유니버셜 은행의 고객 2,500명에 대한 자료(출처 : Data Mining for Business Intelligence, Shmueli et al. 2010)이며, 총 13개의 변수를 포함하고 있다. 이 자료에서 Target은
Personal Loan이다.
1. 데이터 불러오기
pacman::p_load("data.table", "dplyr",
"ggplot2", "GGally",
"caret",
"doParallel", "parallel") # For 병렬 처리
registerDoParallel(cores=detectCores()) # 사용할 Core 개수 지정
UB <- fread("../Universal Bank_Main.csv") # 데이터 불러오기
UB %>%
as_tibble# A tibble: 2,500 × 14
ID Age Experience Income `ZIP Code` Family CCAvg Education
<int> <int> <int> <int> <int> <int> <dbl> <int>
1 1 25 1 49 91107 4 1.6 1
2 2 45 19 34 90089 3 1.5 1
3 3 39 15 11 94720 1 1 1
4 4 35 9 100 94112 1 2.7 2
5 5 35 8 45 91330 4 1 2
6 6 37 13 29 92121 4 0.4 2
7 7 53 27 72 91711 2 1.5 2
8 8 50 24 22 93943 1 0.3 3
9 9 35 10 81 90089 3 0.6 2
10 10 34 9 180 93023 1 8.9 3
# ℹ 2,490 more rows
# ℹ 6 more variables: Mortgage <int>, `Personal Loan` <int>,
# `Securities Account` <int>, `CD Account` <int>, Online <int>,
# CreditCard <int>2. 데이터 전처리
UB %<>%
data.frame() %>% # Data Frame 형태로 변환
mutate(Personal.Loan = ifelse(Personal.Loan == 1, "yes", "no")) %>% # Target을 문자형 변수로 변환
select(-1) # ID 변수 제거
# 1. Convert to Factor
fac.col <- c("Family", "Education", "Securities.Account",
"CD.Account", "Online", "CreditCard",
# Target
"Personal.Loan")
UB <- UB %>%
mutate_at(fac.col, as.factor) # 범주형으로 변환
glimpse(UB) # 데이터 구조 확인Rows: 2,500
Columns: 13
$ Age <int> 25, 45, 39, 35, 35, 37, 53, 50, 35, 34, 6…
$ Experience <int> 1, 19, 15, 9, 8, 13, 27, 24, 10, 9, 39, 5…
$ Income <int> 49, 34, 11, 100, 45, 29, 72, 22, 81, 180,…
$ ZIP.Code <int> 91107, 90089, 94720, 94112, 91330, 92121,…
$ Family <fct> 4, 3, 1, 1, 4, 4, 2, 1, 3, 1, 4, 3, 2, 4,…
$ CCAvg <dbl> 1.6, 1.5, 1.0, 2.7, 1.0, 0.4, 1.5, 0.3, 0…
$ Education <fct> 1, 1, 1, 2, 2, 2, 2, 3, 2, 3, 3, 2, 3, 2,…
$ Mortgage <int> 0, 0, 0, 0, 0, 155, 0, 0, 104, 0, 0, 0, 0…
$ Personal.Loan <fct> no, no, no, no, no, no, no, no, no, yes, …
$ Securities.Account <fct> 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,…
$ CD.Account <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
$ Online <fct> 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1,…
$ CreditCard <fct> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0,…# 2. Convert One-hot Encoding for 범주형 예측 변수
dummies <- dummyVars(formula = ~ ., # formula : ~ 예측 변수 / "." : data에 포함된 모든 변수를 의미
data = UB[,-9], # Dataset including Only 예측 변수 -> Target 제외
fullRank = FALSE) # fullRank = TRUE : Dummy Variable, fullRank = FALSE : One-hot Encoding
UB.Var <- predict(dummies, newdata = UB) %>% # 범주형 예측 변수에 대한 One-hot Encoding 변환
data.frame() # Data Frame 형태로 변환
glimpse(UB.Var) # 데이터 구조 확인Rows: 2,500
Columns: 21
$ Age <dbl> 25, 45, 39, 35, 35, 37, 53, 50, 35, 34,…
$ Experience <dbl> 1, 19, 15, 9, 8, 13, 27, 24, 10, 9, 39,…
$ Income <dbl> 49, 34, 11, 100, 45, 29, 72, 22, 81, 18…
$ ZIP.Code <dbl> 91107, 90089, 94720, 94112, 91330, 9212…
$ Family.1 <dbl> 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, …
$ Family.2 <dbl> 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, …
$ Family.3 <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, …
$ Family.4 <dbl> 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, …
$ CCAvg <dbl> 1.6, 1.5, 1.0, 2.7, 1.0, 0.4, 1.5, 0.3,…
$ Education.1 <dbl> 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Education.2 <dbl> 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 0, …
$ Education.3 <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, …
$ Mortgage <dbl> 0, 0, 0, 0, 0, 155, 0, 0, 104, 0, 0, 0,…
$ Securities.Account.0 <dbl> 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, …
$ Securities.Account.1 <dbl> 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, …
$ CD.Account.0 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
$ CD.Account.1 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Online.0 <dbl> 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, …
$ Online.1 <dbl> 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, …
$ CreditCard.0 <dbl> 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, …
$ CreditCard.1 <dbl> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, …# 3. Combine Target with 변환된 예측 변수
UB.df <- data.frame(Personal.Loan = UB$Personal.Loan,
UB.Var)
UB.df %>%
as_tibble# A tibble: 2,500 × 22
Personal.Loan Age Experience Income ZIP.Code Family.1 Family.2
<fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 no 25 1 49 91107 0 0
2 no 45 19 34 90089 0 0
3 no 39 15 11 94720 1 0
4 no 35 9 100 94112 1 0
5 no 35 8 45 91330 0 0
6 no 37 13 29 92121 0 0
7 no 53 27 72 91711 0 1
8 no 50 24 22 93943 1 0
9 no 35 10 81 90089 0 0
10 yes 34 9 180 93023 1 0
# ℹ 2,490 more rows
# ℹ 15 more variables: Family.3 <dbl>, Family.4 <dbl>, CCAvg <dbl>,
# Education.1 <dbl>, Education.2 <dbl>, Education.3 <dbl>,
# Mortgage <dbl>, Securities.Account.0 <dbl>,
# Securities.Account.1 <dbl>, CD.Account.0 <dbl>,
# CD.Account.1 <dbl>, Online.0 <dbl>, Online.1 <dbl>,
# CreditCard.0 <dbl>, CreditCard.1 <dbl>glimpse(UB.df) # 데이터 구조 확인Rows: 2,500
Columns: 22
$ Personal.Loan <fct> no, no, no, no, no, no, no, no, no, yes…
$ Age <dbl> 25, 45, 39, 35, 35, 37, 53, 50, 35, 34,…
$ Experience <dbl> 1, 19, 15, 9, 8, 13, 27, 24, 10, 9, 39,…
$ Income <dbl> 49, 34, 11, 100, 45, 29, 72, 22, 81, 18…
$ ZIP.Code <dbl> 91107, 90089, 94720, 94112, 91330, 9212…
$ Family.1 <dbl> 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, …
$ Family.2 <dbl> 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, …
$ Family.3 <dbl> 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, …
$ Family.4 <dbl> 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, …
$ CCAvg <dbl> 1.6, 1.5, 1.0, 2.7, 1.0, 0.4, 1.5, 0.3,…
$ Education.1 <dbl> 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Education.2 <dbl> 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 0, …
$ Education.3 <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, …
$ Mortgage <dbl> 0, 0, 0, 0, 0, 155, 0, 0, 104, 0, 0, 0,…
$ Securities.Account.0 <dbl> 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, …
$ Securities.Account.1 <dbl> 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, …
$ CD.Account.0 <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
$ CD.Account.1 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Online.0 <dbl> 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, …
$ Online.1 <dbl> 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, …
$ CreditCard.0 <dbl> 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, …
$ CreditCard.1 <dbl> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, …3. 데이터 탐색
ggpairs(UB, # In 2-1
columns = c("Age", "Experience", "Income", # 수치형 예측 변수
"ZIP.Code", "CCAvg", "Mortgage"),
aes(colour = Personal.Loan)) + # Target의 범주에 따라 색깔을 다르게 표현
theme_bw()
ggpairs(UB, # In 2-1
columns = c("Age", "Experience", "Income", # 수치형 예측 변수
"ZIP.Code", "CCAvg", "Mortgage"),
aes(colour = Personal.Loan)) + # Target의 범주에 따라 색깔을 다르게 표현
scale_color_brewer(palette="Purples") + # 특정 색깔 지정
scale_fill_brewer(palette="Purples") + # 특정 색깔 지정
theme_bw()
ggpairs(UB, # In 2-1
columns = c("Age", "Income", # 수치형 예측 변수
"Family", "Education"), # 범주형 예측 변수
aes(colour = Personal.Loan, alpha = 0.8)) + # Target의 범주에 따라 색깔을 다르게 표현
scale_colour_manual(values = c("purple","cyan4")) + # 특정 색깔 지정
scale_fill_manual(values = c("purple","cyan4")) + # 특정 색깔 지정
theme_bw()
4. 데이터 분할
# Partition (Training Dataset : Test Dataset = 7:3)
y <- UB.df$Personal.Loan # Target
set.seed(200)
ind <- createDataPartition(y, p = 0.7, list = T) # Index를 이용하여 7:3으로 분할
UB.trd <- UB.df[ind$Resample1,] # Training Dataset
UB.ted <- UB.df[-ind$Resample1,] # Test Dataset5. 모형 훈련
Package "caret"은 통합 API를 통해 R로 기계 학습을 실행할 수 있는 매우 실용적인 방법을 제공한다. Package "caret"에서는 초모수의 최적의 조합을 찾는 방법으로 그리드 검색(Grid Search), 랜덤 검색(Random Search), 직접 탐색 범위 설정이 있다. 여기서는 초모수 k의 최적값을 찾기 위해 그리드 검색을 수행하였고, 이를 기반으로 직접 탐색 범위를 설정하였다. 아래는 그리드 검색을 수행하였을 때 결과이다.
fitControl <- trainControl(method = "cv", number = 5, # 5-Fold Cross Validation (5-Fold CV)
allowParallel = TRUE) # 병렬 처리
set.seed(200) # For CV
knn.fit <- train(Personal.Loan ~ ., data = UB.trd,
trControl = fitControl ,
method = "knn",
preProc = c("center", "scale")) # Standardization for 예측 변수
knn.fitk-Nearest Neighbors
1751 samples
21 predictor
2 classes: 'no', 'yes'
Pre-processing: centered (21), scaled (21)
Resampling: Cross-Validated (5 fold)
Summary of sample sizes: 1401, 1401, 1400, 1401, 1401
Resampling results across tuning parameters:
k Accuracy Kappa
5 0.9366007 0.5432290
7 0.9343150 0.5214507
9 0.9314595 0.4942125
Accuracy was used to select the optimal model using the
largest value.
The final value used for the model was k = 5.plot(knn.fit) # Plot
Result! 랜덤하게 결정된 3개의 k 값에 대한 정확도를 보여주며, k = 5일 때 정확도가 가장 높은 것을 알 수 있다. 따라서 그리드 검색을 통해 찾은 최적의 초모수 값 5 근처의 값들을 탐색 범위로 설정하여 훈련을 다시 수행할 수 있다.
customGrid <- expand.grid(k = seq(3, 10, by = 1)) # k의 탐색 범위
set.seed(200) # For CV
knn.tune.fit <- train(Personal.Loan ~ ., data = UB.trd,
trControl = fitControl,
method = "knn",
tuneGrid = customGrid,
preProc = c("center", "scale")) # Standardization for 예측 변수
knn.tune.fitk-Nearest Neighbors
1751 samples
21 predictor
2 classes: 'no', 'yes'
Pre-processing: centered (21), scaled (21)
Resampling: Cross-Validated (5 fold)
Summary of sample sizes: 1401, 1401, 1400, 1401, 1401
Resampling results across tuning parameters:
k Accuracy Kappa
3 0.9428832 0.6069522
4 0.9354579 0.5470401
5 0.9366007 0.5432290
6 0.9354595 0.5344752
7 0.9343150 0.5214507
8 0.9326040 0.5017394
9 0.9314595 0.4942125
10 0.9297485 0.4794890
Accuracy was used to select the optimal model using the
largest value.
The final value used for the model was k = 3.plot(knn.tune.fit) # Plot
knn.tune.fit$bestTune # k의 최적값 k
1 3Result! k = 3일 때 정확도가 가장 높다는 것을 알 수 있으며, k = 3을 가지는 모형을 최적의 훈련된 모형으로 선택한다.
6. 모형 평가
Caution! 모형 평가를 위해 Test Dataset에 대한 예측 class/확률 이 필요하며, 함수 predict()를 이용하여 생성한다.
# 예측 class 생성
knn.pred <- predict(knn.tune.fit,
newdata = UB.ted[,-1]) # Test Dataset including Only 예측 변수
knn.pred %>%
as_tibble# A tibble: 749 × 1
value
<fct>
1 no
2 no
3 no
4 no
5 no
6 no
7 no
8 no
9 no
10 no
# ℹ 739 more rows6-1. ConfusionMatrix
CM <- caret::confusionMatrix(knn.pred, UB.ted$Personal.Loan,
positive = "yes") # confusionMatrix(예측 class, 실제 class, positive = "관심 class")
CMConfusion Matrix and Statistics
Reference
Prediction no yes
no 671 41
yes 2 35
Accuracy : 0.9426
95% CI : (0.9234, 0.9581)
No Information Rate : 0.8985
P-Value [Acc > NIR] : 1.196e-05
Kappa : 0.5924
Mcnemar's Test P-Value : 6.834e-09
Sensitivity : 0.46053
Specificity : 0.99703
Pos Pred Value : 0.94595
Neg Pred Value : 0.94242
Prevalence : 0.10147
Detection Rate : 0.04673
Detection Prevalence : 0.04940
Balanced Accuracy : 0.72878
'Positive' Class : yes
6-2. ROC 곡선
# 예측 확률 생성
test.knn.prob <- predict(knn.tune.fit,
newdata = UB.ted[,-1], # Test Dataset including Only 예측 변수
type = "prob") # 예측 확률 생성
test.knn.prob %>%
as_tibble# A tibble: 749 × 2
no yes
<dbl> <dbl>
1 1 0
2 1 0
3 1 0
4 1 0
5 1 0
6 1 0
7 1 0
8 1 0
9 1 0
10 1 0
# ℹ 739 more rowstest.knn.prob <- test.knn.prob[,2] # "Personal.Loan = yes"에 대한 예측 확률
ac <- UB.ted$Personal.Loan # Test Dataset의 실제 class
pp <- as.numeric(test.knn.prob) # 예측 확률을 수치형으로 변환1) Package “pROC”
pacman::p_load("pROC")
knn.roc <- roc(ac, pp, plot=T, col="gray") # roc(실제 class, 예측 확률)
auc <- round(auc(knn.roc),3)
legend("bottomright", legend = auc, bty = "n")
Caution! Package "pROC"를 통해 출력한 ROC 곡선은 다양한 함수를 이용해서 그래프를 수정할 수 있다.
# 함수 plot.roc() 이용
plot.roc(knn.roc,
col="gray", # Line Color
print.auc = TRUE, # AUC 출력 여부
print.auc.col = "red", # AUC 글씨 색깔
print.thres = TRUE, # Cutoff Value 출력 여부
print.thres.pch = 19, # Cutoff Value를 표시하는 도형 모양
print.thres.col = "red", # Cutoff Value를 표시하는 도형의 색깔
auc.polygon = TRUE, # 곡선 아래 면적에 대한 여부
auc.polygon.col = "gray90") # 곡선 아래 면적의 색깔
# 함수 ggroc() 이용
ggroc(knn.roc) +
annotate(geom = "text", x = 0.9, y = 1.0,
label = paste("AUC = ", auc),
size = 5,
color="red") +
theme_bw()
2) Package “Epi”
pacman::p_load("Epi")
# install_version("etm", version = "1.1", repos = "http://cran.us.r-project.org")
ROC(pp, ac, plot = "ROC") # ROC(예측 확률, 실제 class) 
3) Package “ROCR”
pacman::p_load("ROCR")
knn.pred <- prediction(pp, ac) # prediction(예측 확률, 실제 class)
knn.perf <- performance(knn.pred, "tpr", "fpr") # performance(, "민감도", "1-특이도")
plot(knn.perf, col = "gray") # ROC Curve
perf.auc <- performance(knn.pred, "auc") # AUC
auc <- attributes(perf.auc)$y.values
legend("bottomright", legend = auc, bty = "n")
6-3. 향상 차트
1) Package “ROCR”
knn.perf <- performance(knn.pred, "lift", "rpp") # Lift Chart
plot(knn.perf, main = "lift curve",
colorize = T, # Coloring according to cutoff
lwd = 2) 