L2 Повышение в R - PullRequest
Новая
       16

L2 Повышение в R

1 голос
/ 15 апреля 2019

Я пишу игрушечную реализацию L2 Boosting (стр. 13 из https://projecteuclid.org/euclid.ss/1207580163) в чистом R, только по диадическим причинам.

Так как у меня были проблемы с кодом, я написал этот конкретный случай, который прекрасно работает: 

library(MASS)

set.seed(1234)

idx <- sample(1:nrow(Boston), size = round(0.5*nrow(Boston)), replace = FALSE)
training <- Boston[idx,]
test <- Boston[-idx,]

library(tree)

lambda <- 0.01
B <- 3
psi <- vector("list", B)
g <- vector("list", B)
res <- vector("list", B)

X <- subset(training, select = -medv)

psi_0 <- function(x) rep(mean(training$medv), nrow(training))

medv <- training$medv - psi_0(X)
res[[1]] <- cbind(X, medv)
g[[1]] <- function(x) predict(tree(medv ~ ., res[[1]]), x)
psi[[1]] <- function(x) psi_0(x) + lambda * g[[1]](x)

medv <- training$medv - psi[[1]](X)
res[[2]] <- cbind(X, medv)
g[[2]] <- function(x) predict(tree(medv ~ ., res[[2]]), x)
psi[[2]] <- function(x) psi[[1]](x) + lambda * g[[2]](x)

medv <- training$medv - psi[[2]](X)
res[[3]] <- cbind(X, medv)
g[[3]] <- function(x) predict(tree(medv ~ ., res[[3]]), x)
psi[[3]] <- function(x) psi[[2]](x) + lambda * g[[3]](x)

psi[[3]](test)

[Предупреждение: следующий код приведет к сбою сеанса R. ]

Но, если я попытаюсь написать более общую версию этого цикла, например: 

library(MASS)

set.seed(1234)

idx <- sample(1:nrow(Boston), size = round(0.5*nrow(Boston)), replace = FALSE)
training <- Boston[idx,]
test <- Boston[-idx,]

library(tree)

lambda <- 0.01
B <- 3
psi <- vector("list", B)
g <- vector("list", B)
res <- vector("list", B)

X <- subset(training, select = -medv)

psi_0 <- function(x) rep(mean(training$medv), nrow(training))

for (b in 1:B) {
    if (b == 1) {
        medv <- training$medv - psi_0(X)
        res[[1]] <- cbind(X, medv)
        g[[1]] <- function(x) predict(tree(medv ~ ., res[[1]]), x)
        psi[[1]] <- function(x) psi_0(x) + lambda * g[[1]](x)
    } else {
        medv <- training$medv - psi[[b-1]](X)
        res[[b]] <- cbind(X, medv)
        g[[b]] <- function(x) predict(tree(medv ~ ., res[[b]]), x)
        psi[[b]] <- function(x) psi[[b-1]](x) + lambda * g[[b]](x)
    }
}

psi[[B]](test)

Я получаю ошибку

Ошибка: оценка вложена слишком глубоко: бесконечная рекурсия / опции (выражения =)? Ошибка во время обработки: Ошибка во время обработки: Ошибка во время обработки: ...

и сеанс прерывается. Как отметил Бен в комментариях, это, вероятно, связано с тем, как ленивые вычисления обрабатываются в R.

Любая помощь приветствуется. Спасибо.

...