[R] nnet and weights: error analysis using V&R example

Christoph Lehmann christoph.lehmann at gmx.ch
Thu Sep 23 16:12:23 CEST 2004


Dear R-users, dear Prof. Ripley as package maintainer

I tried to investigate the odd error, when I call nnet together with a 
'weights' parameter, using the 'fgl' example in V&R p 348

The error I get is:

	Error in eval(expr, envir, enclos) : Object "w" not found

I think it is a kind of scoping problem, but I really cannot see, what 
the problem exactly is.

and here is my code: the only thing which changed is the definition of a 
weight-parameter ('w') which is given to the nnet-call. Of course the 
weight vector with '1's makes no sense here, but it will be defined 
according to the class sizes later.

###
library(MASS)
data(flg)

con <- function(...)
{
     print(tab <- table(...))
     diag(tab) <- 0
     cat("error rate = ",
         round(100*sum(tab)/length(list(...)[[1]]), 2), "%\n")
     invisible()
}


set.seed(123)
rand <- sample(10, dim(fgl)[1], replace = T)

fgl1 <- fgl
fgl1[1:9] <- lapply(fgl[, 1:9], function(x) {r <- range(x); (x - 
r[1])/diff(r)})


CVnn2 <- function(formula, data,
                   size = c(0,4,4,10,10), lambda = c(0, rep(c(0.001, 
0.01),2)),
                   nreps = 1, nifold = 5, verbose = 99, ...)
{

     CVnn1 <- function(formula, data, nreps=1, ri, verbose,  ...)
     {
         totalerror <- 0
         truth <- data[,deparse(formula[[2]])]
         res <-  matrix(0, nrow(data), length(levels(truth)))
         if(verbose > 20) cat("  inner fold")
         for (i in sort(unique(ri))) {
             if(verbose > 20) cat(" ", i,  sep="")
             data.training <- data[ri != i,]$GROUP

             w <- rep(1, dim(data[ri !=i,])[1])

             for(rep in 1:nreps) {
                 learn <- nnet(formula, data[ri !=i,],
                               weights = w,
                               trace = F, ...)
                 res[ri == i,] <- res[ri == i,] + predict(learn, data[ri 
== i,])

             }
         }
         if(verbose > 20) cat("\n")
         sum(as.numeric(truth) != max.col(res/nreps))
     }
     truth <- data[,deparse(formula[[2]])]
     res <-  matrix(0, nrow(data), length(levels(truth)))
     choice <- numeric(length(lambda))
     for (i in sort(unique(rand))) {
         if(verbose > 0) cat("fold ", i,"\n", sep="")
         set.seed(i*i)
         ri <- sample(nifold, sum(rand!=i), replace=T)
         for(j in seq(along=lambda)) {
             if(verbose > 10)
                 cat("  size =", size[j], "decay =", lambda[j], "\n")
             choice[j] <- CVnn1(formula, data[rand != i,], nreps=nreps,
                                ri=ri, size=size[j], decay=lambda[j],
                                verbose=verbose, ...)
         }
         decay <- lambda[which.is.max(-choice)]
         csize <- size[which.is.max(-choice)]
         if(verbose > 5) cat("  #errors:", choice, "  ") #
         if(verbose > 1) cat("chosen size = ", csize,
                             " decay = ", decay, "\n", sep="")
         for(rep in 1:nreps) {
             data.training <- data[rand != i,]$GROUP
             w <- rep(1, dim(data[rand !=i,])[1])
             learn <- nnet(formula, data[rand != i,],
                       weights = w,
                       trace=F,
                       size=csize, decay=decay, ...)
             res[rand == i,] <- res[rand == i,] + predict(learn, 
data[rand == i,])
         }
     }
     factor(levels(truth)[max.col(res/nreps)], levels = levels(truth))
}


res.nn2 <- CVnn2(type ~ ., fgl1, skip = T, maxit = 500, nreps = 10)

con(true = fgl$type, predicted = res.nn2)
##


many thanks for your help

Christoph

###


Coordinates:
platform i686-pc-linux-gnu
arch     i686
os       linux-gnu
system   i686, linux-gnu
status
major    1
minor    9.1
year     2004
month    06
day      21
language R


-- 
Christoph Lehmann                            Phone:  ++41 31 930 93 83
Department of Psychiatric Neurophysiology    Mobile: ++41 76 570 28 00
University Hospital of Clinical Psychiatry   Fax:    ++41 31 930 99 61
Waldau                                            lehmann at puk.unibe.ch
CH-3000 Bern 60         http://www.puk.unibe.ch/cl/pn_ni_cv_cl_03.html




More information about the R-help mailing list