Что не так с моей реализацией AdaBoost? - PullRequest
Новая
       12

Что не так с моей реализацией AdaBoost?

0 голосов
/ 11 ноября 2018

Я попытался реализовать алгоритм Фрейнда и Шапира AdaBoost как можно ближе к оригиналу (см. Стр. 2 здесь: http://rob.schapire.net/papers/explaining-adaboost.pdf):

library(rpart)
library(OneR)

maxdepth <- 1
T <- 100 # number of rounds

# Given: (x_1, y_1),...,(x_m, y_m) where x_i element of X, y_i element of {-1, +1}
myocarde <- read.table("http://freakonometrics.free.fr/myocarde.csv", head = TRUE, sep = ";")
#myocarde <- read.table("data/myocarde.csv", header = TRUE, sep = ";")
y <- (myocarde[ , "PRONO"] == "SURVIE") * 2 - 1
x <- myocarde[ , 1:7]
m <- nrow(x)
data <- data.frame(x, y)

# Initialize: D_1(i) = 1/m for i = 1,...,m
D <- rep(1/m, m)

H <- replicate(T, list())
a <- vector(mode = "numeric", T)
set.seed(123)

# For t = 1,...,T
for(t in 1:T) {
  # Train weak learner using distribution D_t
  # Get weak hypothesis h_t: X -> {-1, +1}
  data_D_t <- data[sample(m, 10*m, replace = TRUE, prob = D), ]
  H[[t]] <- rpart(y ~., data = data_D_t, maxdepth = maxdepth, method = "class")
  # Aim: select h_t with low weighted error: e_t = Pr_i~D_t[h_t(x_i) != y_i]
  h <- predict(H[[t]], x, type = "class")
  e <- sum(h != y) / m
  # Choose a_t = 0.5 * log((1-e) / e)
  a[t] <- 0.5 * log((1-e) / e)
  # Update for i = 1,...,m: D_t+1(i) = (D_t(i) * exp(-a_t * y_i * h_t(x_i))) / Z_t
  # where Z_t is a normalization factor (chosen so that Dt+1 will be a distribution) 
  D <- D * exp(-a[t] * y * as.numeric(h))
  D <- D / sum(D)
}
# Output the final hypothesis: H(x) = sign(sum of a_t * h_t(x) for t=1 to T)
newdata <- x
H_x <- sapply(H, function(x) as.numeric(as.character(predict(x, newdata = newdata, type = "class"))))
H_x <- t(a * t(H_x))
pred <- sign(rowSums(H_x))

#H
#a
eval_model(pred, y)
## 
## Confusion matrix (absolute):
##           Actual
## Prediction -1  1 Sum
##        -1   0  1   1
##        1   29 41  70
##        Sum 29 42  71
## 
## Confusion matrix (relative):
##           Actual
## Prediction   -1    1  Sum
##        -1  0.00 0.01 0.01
##        1   0.41 0.58 0.99
##        Sum 0.41 0.59 1.00
## 
## Accuracy:
## 0.5775 (41/71)
## 
## Error rate:
## 0.4225 (30/71)
## 
## Error rate reduction (vs. base rate):
## -0.0345 (p-value = 0.6436)

Как можно видеть, точность модели ужасна по сравнению с другими реализациями AdaBoost, например:

. 
library(JOUSBoost)
## JOUSBoost 2.1.0
boost <- adaboost(as.matrix(x), y, tree_depth = maxdepth, n_rounds = T)
pred <- predict(boost, x)
eval_model(pred, y)
## 
## Confusion matrix (absolute):
##           Actual
## Prediction -1  1 Sum
##        -1  29  0  29
##        1    0 42  42
##        Sum 29 42  71
## 
## Confusion matrix (relative):
##           Actual
## Prediction   -1    1  Sum
##        -1  0.41 0.00 0.41
##        1   0.00 0.59 0.59
##        Sum 0.41 0.59 1.00
## 
## Accuracy:
## 1 (71/71)
## 
## Error rate:
## 0 (0/71)
## 
## Error rate reduction (vs. base rate):
## 1 (p-value < 2.2e-16)

Мой вопрос
Не могли бы вы дать мне подсказку, что пошло не так в моей реализации? Спасибо

Редактировать
Окончательный и исправленный код можно найти в моем блоге: Понимание AdaBoost - или как превратить слабость в силу

1 Ответ

0 голосов
/ 18 ноября 2018

Существует немало факторов, объясняющих, почему ваша реализация не работает.

  1. Вы не правильно использовали rpart. Реализация Adaboost не упоминает повышающую дискретизацию с весами - но сама rpart может принимать весовые коэффициенты. Мой пример ниже показывает, как rpart следует использовать для этой цели.

  2. Расчет взвешенной ошибки был неверным. Вы рассчитывали пропорцию ошибки (неправильно рассчитанное количество образцов, деленное на количество образцов). Adaboost использует сумму весов, которые были неправильно предсказаны (sum(D[y != yhat])).

  3. Окончательные прогнозы тоже казались неверными, я просто закончил с простым циклом.

В следующий раз я рекомендую погрузиться в исходный код других реализаций, с которыми вы сравниваете.

https://github.com/cran/JOUSBoost/blob/master/R/adaboost.R использует код, почти идентичный моему примеру ниже, и, вероятно, помог бы вам изначально.

Кроме того, использование T в качестве переменной потенциально может помешать логическому TRUE, и это сокращение T, поэтому я бы его избегал. 

### packages ###
library(rpart)
library(OneR)

### parameters ###
maxdepth <- 1
rounds <- 100
set.seed(123)

### data ###
myocarde <- read.table("http://freakonometrics.free.fr/myocarde.csv", head = TRUE, sep = ";")
y <- (myocarde[ , "PRONO"] == "SURVIE") * 2 - 1
x <- myocarde[ , 1:7]
m <- nrow(x)
dataset <- data.frame(x, y)

### initialisation ###
D <- rep(1/m, m)
H <- list()
a <- vector(mode = "numeric", length = rounds)

for (i in seq.int(rounds)) {
  # train weak learner
  H[[i]] = rpart(y ~ ., data = dataset, weights = D, maxdepth = maxdepth, method = "class")
  # predictions
  yhat <- predict(H[[i]], x, type = "class")
  yhat <- as.numeric(as.character(yhat))
  # weighted error
  e <- sum(D[yhat != y])
  # alpha coefficient
  a[i] <- 0.5 * log((1 - e) / e)
  # updating weights (D)
  D <- D * exp(-a[i] * y * yhat)
  D <- D / sum(D)
}

# predict with each weak learner on dataset
y_hat_final <- vector(mode = "numeric", length = m)
for (i in seq(rounds)) {
  pred = predict(H[[i]], dataset, type = "class")
  pred = as.numeric(as.character(pred))
  y_hat_final = y_hat_final + (a[i] * pred)
}
pred <- sign(y_hat_final)

eval_model(pred, y)

> eval_model(pred, y)

Confusion matrix (absolute):
          Actual
Prediction -1  1 Sum
       -1  29  0  29
       1    0 42  42
       Sum 29 42  71

Confusion matrix (relative):
          Actual
Prediction   -1    1  Sum
       -1  0.41 0.00 0.41
       1   0.00 0.59 0.59
       Sum 0.41 0.59 1.00

Accuracy:
1 (71/71)

Error rate:
0 (0/71)

Error rate reduction (vs. base rate):
1 (p-value < 2.2e-16)
...