R/mean.R

In sboost: Machine Learning with AdaBoost on Decision Stumps

mean_stump <- function(p, o, r) .Call(mean_stump_, p, o, r)

means <- function(features, outcomes, iterations) {

  ordered_index <- matrix(NA, nrow = nrow(features), ncol = ncol(features))
  for (i in 1:ncol(features)) {
    ordered_index[, i] <- order(features[, i]) - 1L
  }
  weights <- rep(1 / nrow(features), nrow(features))

  model <- data.frame(
    feature = rep(0, iterations),
    vote = rep(0, iterations),
    split = rep(0, iterations),
    mean_behind = rep(0, iterations),
    mean_ahead = rep(0, iterations)
  )

  candidates <- data.frame(
    error = rep(0, ncol(features)),
    split = rep(0, ncol(features)),
    mean_behind = rep(0, ncol(features)),
    mean_ahead = rep(0, ncol(features))
  )

  for (i in 1:iterations) {
    selection <- sample(1L:nrow(features), nrow(features), replace = TRUE, prob = weights)
    selection <- sort(selection)

    for (j in 1:ncol(features)) {
      candidates[j,] <- mean_stump(
        as.numeric(features[, j]),
        ordered_index[selection, j],
        as.numeric(outcomes)
      )
    }

    stump_feature <- which.min(candidates$error)
    stump_split <- candidates$split[stump_feature]
    stump_mean_behind <- candidates$mean_behind[stump_feature]
    stump_mean_ahead <- candidates$mean_ahead[stump_feature]

    predictions <- ifelse(features[, stump_feature] < stump_split, stump_mean_behind, stump_mean_ahead)
    losses <- (outcomes - predictions)^2
    losses <- losses / max(losses)
    ave_loss <- sum(losses * weights)
    beta = ave_loss / (1 - ave_loss)
    vote = log(1 / beta)

    weights = weights * beta^(1 - losses)
    weights = weights / sum(weights)

    if (ave_loss >= 0.5) {
      model <- model[1:(i - 1),]
      break
    }

    model[i,] <- c(stump_feature, vote, stump_split, stump_mean_behind, stump_mean_ahead)
  }

  return(model)
}