[R통계] ISLRv2 Introduction to Statistical Learning : exercise solutions - 4강 분류 13번 문제풀이

13번 문제풀이

 

Boston 자료를 사용하여 분류 모델들을 적합하고, 주어진 교외 지역의 범죄율이 중앙값보다 높거나 낮은지 예측하라. 설명변수들의 다양한 부분 집합을 사용하여 로지스틱회귀, LDA, KNN모델을 살펴보고 발견한 것을 설명하라.

 

 

01. 데이터 준비

library(MASS)
library(class)
library(tidyverse)
library(corrplot)
library(ISLR2)
library(e1071)

x <- cbind(
  ISLR2::Boston[, -1], 
  data.frame("highcrim" = Boston$crim > median(Boston$crim))
)
set.seed(1)
train <- sample(seq_len(nrow(x)), nrow(x) * 2/3)

- data.frame("highcrim" = Boston$crim > median(Boston$crim))

(Boston dataset의 crim 칼럼의 값의 median값보다 높다면 True, 낮다면 Fasle를 반환하여 highcrim 칼럼에 할당)

 

- 전체 데이터셋의 3분의2를 train set으로 활용

 

 

 

 

02. 변수 중요도 평가

Willcox 테스트를 수행하면 가장 관련성이 높은 변수를 찾을 수 있다.

ord <- order(sapply(1:12, function(i) {
  p <- wilcox.test(as.numeric(x[train, i]) ~ x[train, ]$highcrim)$p.value
  setNames(log10(p), colnames(x)[i])
}))
ord <- names(x)[ord]
ord

x <- x[, c(ord, "highcrim")]

 

Boston 데이터 세트의 처음 12개의 변수와 highcrim변수간의 유의성을 검정하고, 그 결과를 기반으로 변수를 p-value의 오름차순으로 재정렬한다. 또한 재정렬된 변수이름은 ord에 저장됨

 

 

 

 

03. 변수 중요도에 따른 데이터 재구성

x <- x[, c(ord, "highcrim")]


x[train, ] |>
  pivot_longer(!highcrim) |>
  mutate(name = factor(name, levels = ord)) |>
  ggplot(aes(highcrim, value)) + 
  geom_boxplot() + 
  facet_wrap(~name, scale = "free")

각 boxplot은 해당 변수의 분포를 'highcrim'값(True 또는 Fasle)에 따라 나타냈다. 이때 'highcrim'이 True인 경우는 해당 지역의 범죄율이 전체 중앙값보다 높다는 의미이며, Fasle인 경우는 중앙값보다 낮다는것을 의미한다.

 

위의 boxplot의 해석은 다음과 같다.

- nox(일산화질소 농도): 범죄율이 높은 지역(True)에서의 일산화 질소 농도가 일반적으로 높다.

- dis(고용 센터까지의 거리) : 범죄율이 높은 지역에서는 고용 센터 까지의 거리가 짧다.

- indus(비소매 상업 지역의 비율) : 범죄율이 높은 지역에서 비소매 상업 지역의 비율이 더 높다.

등등

 

 

 

 

04. 모델 적합 및 성능 평가 함수 생성

fit_models <- function(cols, k_vals = 1:50) {
  dat_train <- x[train, cols, drop = FALSE]
  dat_test <- x[-train, cols, drop = FALSE]
  
  fit <- lda(x$highcrim[train] ~ ., data = dat_train)
  pred <- predict(fit, dat_test, type = "response")$class
  lda_err <- mean(pred != x$highcrim[-train])
  
  fit <- glm(x$highcrim[train] ~ ., data = dat_train, family = binomial)
  pred <- predict(fit, dat_test, type = "response") > 0.5
  logreg_err <- mean(pred != x$highcrim[-train])
  
  fit <- naiveBayes(x$highcrim[train] ~ ., data = dat_train)
  pred <- predict(fit, dat_test, type = "class")
  nb_err <- mean(pred != x$highcrim[-train])
  
  res <- sapply(k_vals, function(k) {
    fit <- knn(dat_train, dat_test, x$highcrim[train], k = k)
    mean(fit != x$highcrim[-train])
  })
  knn_err <- min(res)
  
  c("LDA" = lda_err, "LR" = logreg_err, "NB" = nb_err, "KNN" = knn_err)
}

 

 

 

 

05. 모델 성능 평가 및 시각화

res <- sapply(1:12, function(max) fit_models(1:max))
res <- as_tibble(t(res))
res$n_var <- 1:12
pivot_longer(res, cols = !n_var) |>
  ggplot(aes(n_var, value, col = name)) + 
  geom_line() + 
  xlab("Number of predictors") + 
  ylab

'res'는 각 변수에 따른 네가지 모델 (LDA, 로지스틱 회귀, 나이브베이즈, KNN)의 예측 오류를 담은 행렬

위 그래프는 네가지 분류 모델의 예측 Error rate를 나타낸다. 위의 그래프에서는 KNN모델이 가장 오류가 적음을 알 수 있다.