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

时间:2015-01-18 13:09:16

标签: r recursion functional-programming closures perceptron

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

  

错误:评估嵌套太深:无限递归/   选项(表达式=)?换行时出错:评估嵌套也是如此   deep:无限递归/选项(表达式=)?

以下是Kernalised感知器的示例。我生成一些线性可分的数据并尝试适应它。函数加法发生在函数kern.perceptron中,其中I:

  1. 根据数据创建一个函数:kernel <- FUN(x, ...)。从调用中转换为创建函数function(t) (x %*% t)^3,其中x应该评估。 (我想这就是我可能会摔倒的地方)。
  2. 将此函数添加/减去现有函数wHat
  3. 如何正确更新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)
    

1 个答案:

答案 0 :(得分:2)

我认为你的堆栈溢出是因为你创建了一个越来越深层嵌套的函数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)

你得到了注册中内核函数的总和,我认为这就是你想要的。

顺便说一下,你也可以不用关闭来做到这一点......