使用闭包增加 R 中的函数（递归地将使用闭包构造的函数添加到现有函数）

Question

我正在尝试从一些数据创建一个函数w(t)。我通过循环数据、创建一个函数并将其添加到w(t) 来做到这一点。我遇到了无限递归问题，因为我不知道 R 何时评估变量。我得到的错误信息是：

错误：评估嵌套太深：无限递归 / 选项（表达式=）？总结期间的错误：评估也嵌套 深度：无限递归/选项（表达式=）？

以下是内核化感知器的示例。我生成了一些线性可分的数据并尝试拟合它。函数加法发生在函数kern.perceptron 中，其中我：

1. 根据数据创建函数：kernel <- FUN(x, ...)。从调用这转换为创建一个函数function(t) (x %*% t)^3，其中 x 应该被评估。 （我认为这可能是我跌倒的地方）。
2. 将此函数添加/减去现有函数wHat

如何正确更新函数，使wHat(t) = wHat(t) + kernel(t)？

prepend.bias <- function(X){
    cbind(rep(1, nrow(X)), X)
}

pred.perc <- function(X, w, add.bias=FALSE){
    X <- as.matrix(X)
    if (add.bias) X <- prepend.bias(X)
    sign(X %*% w)
}

polyKernel <- function(x, d=2){
    # Function that creates a kernel function for a given data point
    # Expects data point as row matrix
    function(t){
        # expects t as vector or col matrix
        t <- as.matrix(t)
        (x %*% t)^d
    }
}

pred.kperc <- function(X, w, add.bias=FALSE){
    X <- as.matrix(X)
    if (add.bias) X <- prepend.bias(X)
    as.matrix(sign(apply(X, 1, w)))
}

kern.perceptron <- function(X, Y, max.epoch=1, verbose=FALSE, 
                            FUN=polyKernel, ...) {
    wHat <- function(t) 0
    alpha <- numeric(0)
    X <- prepend.bias(X)
    bestmistakes <- Inf
    n <- nrow(X)
    for (epoch in 1:max.epoch) {
        improved <- FALSE
        mistakes <- 0
        for (i in 1:n) {
            x <- X[i,,drop=F]
            yHat <- pred.kperc(x, wHat)
            if (Y[i] != yHat) {
                alpha <- c(alpha, Y[i])
                wPrev <- wHat
                kernel <- FUN(x, ...)
                if (Y[i] == -1){
                    wHat <- function(t) wPrev(t) - kernel(t)
                } else{
                    wHat <- function(t) wPrev(t) + kernel(t)
                }

                mistakes <- mistakes + 1
            }
            else alpha <- c(alpha, 0)
        }
        totmistakes <- sum(Y != pred.kperc(X, wHat))
        if (totmistakes < bestmistakes){
            bestmistakes <- totmistakes
            pocket <- wHat
            improved <- TRUE
        }
        if (verbose) {
            message(paste("\nEpoch:", epoch, "\nMistakes In Loop:", mistakes,
                          "\nCurrent Solution Mistakes:", totmistakes, 
                          "\nBest Solution Mistakes:", bestmistakes))
            if (!improved)
                message(paste("WARNING: Epoch", epoch, "No improvement"))
        }
    }
    return(pocket)
}

set.seed(10230)
w <- c(0.3, 0.9, -2)
X <- gendata(100, 2)
Y <- pred.perc(X, w, TRUE)
wHat <- kern.perceptron(X, Y, 10, TRUE, polyKernel, d=3)

Answer 1

我认为你得到堆栈溢出是因为你创建了一个越来越深的嵌套函数wHat。您可以在闭包中保留内核函数的注册表，如下所示：

LL  <-  local({
    #initialize list of kernel functions in the closeure
    funlist = list()
    #a logical vector indicating whether or not to add or subtract the kernal functio
    .sign = logical(zero)


    #register a kernal function and it's sign
    register <- function(fun,sign,x){
        funlist<<-c(funlist,list(fun))
        add<<-c(add,sign)
    }

    # wHat uses k in the closure without having to pass it as an argument
    wHat <- function(t){

        out = 0
        for(i in seq(length(.sign))
            if (.sign[i]){
                out <- out + funlist[[i]](t)
            } else{
                out <- out - funlist[[i]](t)
            }
    }
    list(wHat,register)
})

wHat  <-  LL$wHat
register  <-  LL$register

然后注册一个你调用的内核函数

register(KernelFun,sign)

当你打电话时

wHat(t)

你得到了寄存器中内核函数的总和，我认为这就是你想要的。

顺便说一句，你也可以在没有闭包的情况下做到这一点......