Increment a function in R using a closure（将使用闭包构造的函数递归添加到现有函数）

Question

我正在尝试根据一些数据创建一个函数 w(t)。我通过遍历数据、创建函数并将其添加到 w(t) 来实现这一点。我运行遇到无限递归问题，因为我不知道 R 何时计算变量。我收到的错误消息是：

Error: evaluation nested too deeply: infinite recursion / options(expressions=)? Error during wrapup: evaluation nested too deeply: infinite recursion / options(expressions=)?

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

根据数据创建函数：kernel <- FUN(x, ...)。从调用中，这转化为创建一个函数 function(t) (x %*% t)^3，其中 x 应该被计算。（我想这是我可能会倒下的地方）。
add/subtract这个函数到现有函数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)

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

顺便说一句，您也可以在没有闭包的情况下执行此操作...

Increment a function in R using a closure（将使用闭包构造的函数递归添加到现有函数）

Increment a function in R using a closure (recursively add a function constructed using a closure to an existing function)

recursion

closures

functional-programming

r

perceptron