nnet/0000755000176000001440000000000012164264456011260 5ustar ripleyusersnnet/DESCRIPTION0000644000176000001440000000140312164265440012756 0ustar ripleyusersPackage: nnet Priority: recommended Version: 7.3-7 Date: 2013-07-01 Depends: R (>= 2.14.0), stats, utils Suggests: MASS Authors@R: c(person("Brian", "Ripley", role = c("aut", "cre", "cph"), email = "ripley@stats.ox.ac.uk")) Author: Brian Ripley . Maintainer: Brian Ripley Copyright: W. N. Venables and B. D. Ripley Description: Software for feed-forward neural networks with a single hidden layer, and for multinomial log-linear models. Title: Feed-forward Neural Networks and Multinomial Log-Linear Models ByteCompile: yes License: GPL-2 | GPL-3 URL: http://www.stats.ox.ac.uk/pub/MASS4/ Packaged: 2013-07-01 11:32:28 UTC; ripley NeedsCompilation: yes Repository: CRAN Date/Publication: 2013-07-01 13:42:24 nnet/LICENCE.note0000644000176000001440000000301112164263531013175 0ustar ripleyusersSoftware and datasets to support 'Modern Applied Statistics with S', fourth edition, by W. N. Venables and B. D. Ripley. Springer, 2002. From the text (pp. 464): These datasets and software are provided in good faith, but none of the authors, publishers nor distributors warrant their accuracy nor can be held responsible for the consequences of their use. This file is intended to clarify ownership and copyright: where possible individual files also carry brief copyright notices. Copyrights ========== All files are copyright (C) 1994-2013 W. N. Venables and B. D. Ripley. Those parts which were distributed with the first edition are also copyright (C) 1994 Springer-Verlag New York Inc, with all rights assigned to W. N. Venables and B. D. Ripley. Licence ======= This is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 or 3 of the License (at your option). This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. Files share/licenses/GPL-2 and share/licenses/GPL-3 in the R (source or binary) distribution are copies of versions 2 and 3 of the 'GNU General Public License'. These can also be viewed at http://www.r-project.org/licenses/ Bill.Venables@csiro.au ripley@stats.ox.ac.uk nnet/NAMESPACE0000644000176000001440000000163611754561331012501 0ustar ripleyusersuseDynLib(nnet, .registration = TRUE) export(class.ind, multinom, nnet, nnetHess, which.is.max) # match.call problem export(nnet.default, nnet.formula) importFrom(stats, add1) importFrom(stats, anova) importFrom(stats, coef) importFrom(stats, drop1) importFrom(stats, extractAIC) importFrom(stats, model.frame) importFrom(stats, predict) importFrom(stats, vcov) S3method(add1, multinom) S3method(anova, multinom) S3method(coef, multinom) S3method(confint, multinom) S3method(drop1, multinom) S3method(extractAIC, multinom) S3method(logLik, multinom) S3method(model.frame, multinom) S3method(predict, multinom) S3method(print, multinom) S3method(print, summary.multinom) S3method(summary, multinom) S3method(vcov, multinom) S3method(coef, nnet) S3method(predict, nnet) S3method(print, nnet) S3method(print, summary.nnet) # S3method(residuals, nnet) S3method(summary, nnet) S3method(nnet, default) S3method(nnet, formula) nnet/R/0000755000176000001440000000000012164264314011452 5ustar ripleyusersnnet/R/multinom.R0000644000176000001440000004047211754561330013452 0ustar ripleyusers# file nnet/multinom.R # copyright (C) 1994-2006 W. N. Venables and B. D. Ripley # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ # multinom <- function(formula, data, weights, subset, na.action, contrasts = NULL, Hess = FALSE, summ = 0, censored = FALSE, model = FALSE, ...) { class.ind <- function(cl) { n <- length(cl) x <- matrix(0, n, length(levels(cl))) ## get codes of a factor x[(1L:n) + n * (as.integer(cl) - 1L)] <- 1 dimnames(x) <- list(names(cl), levels(cl)) x } summ2 <- function(X, Y) { X <- as.matrix(X) Y <- as.matrix(Y) n <- nrow(X) p <- ncol(X) q <- ncol(Y) Z <- t(cbind(X, Y)) storage.mode(Z) <- "double" z <- .C(VR_summ2, as.integer(n), as.integer(p), as.integer(q), Z = Z, na = integer(1L)) Za <- t(z$Z[, 1L:z$na, drop = FALSE]) list(X = Za[, 1L:p, drop = FALSE], Y = Za[, p + 1L:q]) } call <- match.call() m <- match.call(expand.dots = FALSE) m$summ <- m$Hess <- m$contrasts <- m$censored <- m$model <- m$... <- NULL m[[1L]] <- as.name("model.frame") m <- eval.parent(m) Terms <- attr(m, "terms") X <- model.matrix(Terms, m, contrasts) cons <- attr(X, "contrasts") Xr <- qr(X)$rank Y <- model.response(m) if(!is.matrix(Y)) Y <- as.factor(Y) w <- model.weights(m) if(length(w) == 0L) if(is.matrix(Y)) w <- rep(1, dim(Y)[1L]) else w <- rep(1, length(Y)) lev <- levels(Y) if(is.factor(Y)) { counts <- table(Y) if(any(counts == 0L)) { empty <- lev[counts == 0L] warning(sprintf(ngettext(length(empty), "group %s is empty", "groups %s are empty"), paste(sQuote(empty), collapse=" ")), domain = NA) Y <- factor(Y, levels=lev[counts > 0L]) lev <- lev[counts > 0L] } if(length(lev) < 2L) stop("need two or more classes to fit a multinom model") if(length(lev) == 2L) Y <- as.integer(Y) - 1 else Y <- class.ind(Y) } if(summ == 1) { Z <- cbind(X, Y) z1 <- cumprod(apply(Z, 2L, max)+1) Z1 <- apply(Z, 1L, function(x) sum(z1*x)) oZ <- order(Z1) Z2 <- !duplicated(Z1[oZ]) oX <- (seq_along(Z1)[oZ])[Z2] X <- X[oX, , drop=FALSE] Y <- if(is.matrix(Y)) Y[oX, , drop=FALSE] else Y[oX] w <- diff(c(0,cumsum(w))[c(Z2,TRUE)]) print(dim(X)) } if(summ == 2) { Z <- summ2(cbind(X, Y), w) X <- Z$X[, 1L:ncol(X)] Y <- Z$X[, ncol(X) + 1L:ncol(Y), drop = FALSE] w <- Z$Y print(dim(X)) } if(summ == 3) { Z <- summ2(X, Y*w) X <- Z$X Y <- Z$Y[, 1L:ncol(Y), drop = FALSE] w <- rep(1, nrow(X)) print(dim(X)) } offset <- model.offset(m) r <- ncol(X) if(is.matrix(Y)) { # 3 or more response levels or direct matrix spec. p <- ncol(Y) sY <- Y %*% rep(1, p) if(any(sY == 0)) stop("some case has no observations") if(!censored) { Y <- Y / matrix(sY, nrow(Y), p) w <- w*sY } if(length(offset) > 1L) { if(ncol(offset) != p) stop("ncol(offset) is wrong") mask <- c(rep(FALSE, r+1L+p), rep(c(FALSE, rep(TRUE, r), rep(FALSE, p)), p-1L) ) X <- cbind(X, offset) Wts <- as.vector(rbind(matrix(0, r+1L, p), diag(p))) fit <- nnet.default(X, Y, w, Wts=Wts, mask=mask, size=0, skip=TRUE, softmax=TRUE, censored=censored, rang=0, ...) } else { mask <- c(rep(FALSE, r+1L), rep(c(FALSE, rep(TRUE, r)), p-1L) ) fit <- nnet.default(X, Y, w, mask=mask, size=0, skip=TRUE, softmax=TRUE, censored=censored, rang=0, ...) } } else { # 2 response levels if(length(offset) <= 1L) { mask <- c(FALSE, rep(TRUE, r)) fit <- nnet.default(X, Y, w, mask=mask, size=0, skip=TRUE, entropy=TRUE, rang=0, ...) } else { mask <- c(FALSE, rep(TRUE, r), FALSE) Wts <- c(rep(0, r+1L), 1) X <- cbind(X, offset) fit <- nnet.default(X, Y, w, Wts=Wts, mask=mask, size=0, skip=TRUE, entropy=TRUE, rang=0, ...) } } fit$formula <- attr(Terms, "formula") fit$terms <- Terms fit$call <- call fit$weights <- w fit$lev <- lev fit$deviance <- 2 * fit$value fit$rank <- Xr edf <- ifelse(length(lev) == 2L, 1, length(lev)-1)*Xr if(is.matrix(Y)) { edf <- (ncol(Y)-1)*Xr if(length(dn <- colnames(Y)) > 0) fit$lab <- dn else fit$lab <- 1L:ncol(Y) } fit$coefnames <- colnames(X) fit$vcoefnames <- fit$coefnames[1L:r] # remove offset cols fit$na.action <- attr(m, "na.action") fit$contrasts <- cons fit$xlevels <- .getXlevels(Terms, m) fit$edf <- edf fit$AIC <- fit$deviance + 2 * edf if(model) fit$model <- m class(fit) <- c("multinom", "nnet") if(Hess) fit$Hessian <- multinomHess(fit, X) fit } predict.multinom <- function(object, newdata, type=c("class","probs"), ...) { if(!inherits(object, "multinom")) stop("not a \"multinom\" fit") type <- match.arg(type) if(missing(newdata)) Y <- fitted(object) else { newdata <- as.data.frame(newdata) rn <- row.names(newdata) Terms <- delete.response(object$terms) m <- model.frame(Terms, newdata, na.action = na.omit, xlev = object$xlevels) if (!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) keep <- match(row.names(m), rn) X <- model.matrix(Terms, m, contrasts = object$contrasts) Y1 <- predict.nnet(object, X) Y <- matrix(NA, nrow(newdata), ncol(Y1), dimnames = list(rn, colnames(Y1))) Y[keep, ] <- Y1 } switch(type, class={ if(length(object$lev) > 2L) Y <- factor(max.col(Y), levels=seq_along(object$lev), labels=object$lev) if(length(object$lev) == 2L) Y <- factor(1 + (Y > 0.5), levels=1L:2L, labels=object$lev) if(length(object$lev) == 0L) Y <- factor(max.col(Y), levels=seq_along(object$lab), labels=object$lab) }, probs={}) drop(Y) } print.multinom <- function(x, ...) { if(!is.null(cl <- x$call)) { cat("Call:\n") dput(cl, control = NULL) } cat("\nCoefficients:\n") print(coef(x), ...) cat("\nResidual Deviance:", format(x$deviance), "\n") cat("AIC:", format(x$AIC), "\n") invisible(x) } coef.multinom <- function(object, ...) { r <- length(object$vcoefnames) if(length(object$lev) == 2L) { coef <- object$wts[1L+(1L:r)] names(coef) <- object$vcoefnames } else { coef <- matrix(object$wts, nrow = object$n[3L], byrow=TRUE)[, 1L+(1L:r), drop=FALSE] if(length(object$lev)) dimnames(coef) <- list(object$lev, object$vcoefnames) if(length(object$lab)) dimnames(coef) <- list(object$lab, object$vcoefnames) coef <- coef[-1L, , drop=FALSE] } coef } drop1.multinom <- function(object, scope, sorted = FALSE, trace = FALSE, ...) { if(!inherits(object, "multinom")) stop("not a \"multinom\" fit") if(missing(scope)) scope <- drop.scope(object) else { if(!is.character(scope)) scope <- attr(terms(update.formula(object, scope)), "term.labels") if(!all(match(scope, attr(object$terms, "term.labels"), nomatch = 0L))) stop("'scope' is not a subset of term labels") } ns <- length(scope) ans <- matrix(nrow = ns+1L, ncol = 2L, dimnames = list(c("", scope), c("Df", "AIC"))) ans[1, ] <- c(object$edf, object$AIC) n0 <- length(object$residuals) i <- 2L for(tt in scope) { cat("trying -", tt,"\n") nobject <- update(object, paste("~ . -", tt), trace = trace, evaluate = FALSE) nobject <- eval.parent(nobject) if(nobject$edf == object$edf) nobject$AIC <- NA ans[i, ] <- c(nobject$edf, nobject$AIC) if(length(nobject$residuals) != n0) stop("number of rows in use has changed: remove missing values?") i <- i+1L } if(sorted) ans <- ans[order(ans[, 2L]), ] as.data.frame(ans) } add1.multinom <- function(object, scope, sorted = FALSE, trace = FALSE, ...) { if(!inherits(object, "multinom")) stop("not a \"multinom\" fit") if(!is.character(scope)) scope <- add.scope(object, update.formula(object, scope, evaluate = FALSE)) if(!length(scope)) stop("no terms in 'scope' for adding to object") ns <- length(scope) ans <- matrix(nrow = ns+1L, ncol = 2L, dimnames = list(c("",paste("+",scope,sep="")), c("Df", "AIC"))) ans[1L, ] <- c(object$edf, object$AIC) n0 <- length(object$residuals) i <- 2L for(tt in scope) { cat("trying +", tt,"\n") nobject <- update(object, as.formula(paste("~ . +", tt)), trace = trace, evaluate = FALSE) nobject <- eval.parent(nobject) if(nobject$edf == object$edf) nobject$AIC <- NA ans[i, ] <- c(nobject$edf, nobject$AIC) if(length(nobject$residuals) != n0) stop("number of rows in use has changed: remove missing values?") i <- i+1L } if(sorted) ans <- ans[order(ans[, 2L]), ] as.data.frame(ans) } extractAIC.multinom <- function(fit, scale, k = 2, ...) c(fit$edf, fit$AIC + (k-2)*fit$edf) vcov.multinom <- function(object, ...) { ginv <- function(X, tol = sqrt(.Machine$double.eps)) { # # simplified version of ginv in MASS # Xsvd <- svd(X) Positive <- Xsvd$d > max(tol * Xsvd$d[1L], 0) if(!any(Positive)) array(0, dim(X)[2L:1L]) else Xsvd$v[, Positive] %*% ((1/Xsvd$d[Positive]) * t(Xsvd$u[, Positive])) } if(is.null(Hess <- object$Hessian)) Hess <- multinomHess(object) structure(ginv(Hess), dimnames = dimnames(Hess)) } summary.multinom <- function(object, correlation = FALSE, digits = options()$digits, Wald.ratios = FALSE, ...) { vc <- vcov(object) r <- length(object$vcoefnames) se <- sqrt(diag(vc)) if(length(object$lev) == 2L) { coef <- object$wts[1L + (1L:r)] stderr <- se names(coef) <- names(stderr) <- object$vcoefnames } else { coef <- matrix(object$wts, nrow = object$n[3L], byrow = TRUE)[-1L, 1L + (1L:r), drop = FALSE] stderr <- matrix(se, nrow = object$n[3L] - 1L, byrow = TRUE) if(length(l <- object$lab) || length(l <- object$lev)) dimnames(coef) <- dimnames(stderr) <- list(l[-1L], object$vcoefnames) } object$is.binomial <- (length(object$lev) == 2L) object$digits <- digits object$coefficients <- coef object$standard.errors <- stderr if(Wald.ratios) object$Wald.ratios <- coef/stderr if(correlation) object$correlation <- vc/outer(se, se) class(object) <- "summary.multinom" object } print.summary.multinom <- function(x, digits = x$digits, ...) { if(!is.null(cl <- x$call)) { cat("Call:\n") dput(cl, control = NULL) } cat("\nCoefficients:\n") if(x$is.binomial) { print(cbind(Values = x$coefficients, "Std. Err." = x$standard.errors, "Value/SE" = x$Wald.ratios), digits = digits) } else { print(x$coefficients, digits = digits) cat("\nStd. Errors:\n") print(x$standard.errors, digits = digits) if(!is.null(x$Wald.ratios)) { cat("\nValue/SE (Wald statistics):\n") print(x$coefficients/x$standard.errors, digits = digits) } } cat("\nResidual Deviance:", format(x$deviance), "\n") cat("AIC:", format(x$AIC), "\n") if(!is.null(correl <- x$correlation)) { p <- dim(correl)[2L] if(p > 1) { cat("\nCorrelation of Coefficients:\n") ll <- lower.tri(correl) correl[ll] <- format(round(correl[ll], digits)) correl[!ll] <- "" print(correl[-1L, -p], quote = FALSE, ...) } } invisible(x) } anova.multinom <- function(object, ..., test = c("Chisq", "none")) { test <- match.arg(test) dots <- list(...) if(length(dots) == 0) stop('anova is not implemented for a single "multinom" object') mlist <- list(object, ...) nt <- length(mlist) dflis <- sapply(mlist, function(x) x$edf) s <- order(dflis) ## careful, might use na.exclude here dflis <- nrow(object$residuals) * (ncol(object$residuals)-1) - dflis mlist <- mlist[s] if(any(!sapply(mlist, inherits, "multinom"))) stop('not all objects are of class "multinom"') ns <- sapply(mlist, function(x) length(x$residuals)) if(any(ns != ns[1L])) stop("models were not all fitted to the same size of dataset") rsp <- unique(sapply(mlist, function(x) paste(formula(x)[2L]))) mds <- sapply(mlist, function(x) paste(formula(x)[3L])) dfs <- dflis[s] lls <- sapply(mlist, function(x) deviance(x)) tss <- c("", paste(1L:(nt - 1), 2L:nt, sep = " vs ")) df <- c(NA, -diff(dfs)) x2 <- c(NA, -diff(lls)) pr <- c(NA, 1 - pchisq(x2[-1L], df[-1L])) out <- data.frame(Model = mds, Resid.df = dfs, Deviance = lls, Test = tss, Df = df, LRtest = x2, Prob = pr) names(out) <- c("Model", "Resid. df", "Resid. Dev", "Test", " Df", "LR stat.", "Pr(Chi)") if(test == "none") out <- out[, 1L:6L] class(out) <- c("Anova", "data.frame") attr(out, "heading") <- c("Likelihood ratio tests of Multinomial Models\n", paste("Response:", rsp)) out } model.frame.multinom <- function(formula, ...) { dots <- list(...) nargs <- dots[match(c("data", "na.action", "subset"), names(dots), 0)] if(length(nargs) || is.null(formula$model)) { oc <- formula$call oc[[1L]] <- as.name("model.frame") m <- match(names(oc)[-1L], c("formula", "data", "na.action", "subset")) oc <- oc[c(TRUE, !is.na(m))] oc[names(nargs)] <- nargs if (is.null(env <- environment(formula$terms))) env <- parent.frame() eval(oc, env) } else formula$model } confint.multinom <- function (object, parm, level = 0.95, ...) { cf <- coef(object) ## matrix case covers e.g. multinom. pnames <- if(is.matrix(cf)) colnames(cf) else names(cf) if (missing(parm)) parm <- seq_along(pnames) else if (is.character(parm)) parm <- match(parm, pnames, nomatch = 0L) a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100*a, 1), "%") fac <- qnorm(a) if(is.matrix(cf)) { ses <- matrix(sqrt(diag(vcov(object))), ncol=ncol(cf), byrow=TRUE)[, parm, drop = FALSE] cf <- cf[, parm, drop = FALSE] ci <- array(NA, dim = c(dim(cf), 2L), dimnames = c(dimnames(cf), list(pct))) ci[,,1L] <- cf + ses*fac[1L] ci[,,2L] <- cf + ses*fac[2L] aperm(ci, c(2L,3L,1L)) } else { ci <- array(NA, dim = c(length(parm), 2L), dimnames = list(pnames[parm], pct)) ses <- sqrt(diag(vcov(object)))[parm] ci[] <- cf[parm] + ses %o% fac ci } } logLik.multinom <- function(object, ...) structure(-0.5 * object$deviance, df = object$edf, nobs = sum(object$weights), class = "logLik") nnet/R/nnet.R0000644000176000001440000003117512027627304012550 0ustar ripleyusers# file nnet/nnet.R # copyright (C) 1994-2003 W. N. Venables and B. D. Ripley # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ # nnet <- function(x, ...) UseMethod("nnet") nnet.formula <- function(formula, data, weights, ..., subset, na.action, contrasts=NULL) { class.ind <- function(cl) { n <- length(cl) x <- matrix(0, n, length(levels(cl))) x[(1L:n) + n * (as.vector(unclass(cl)) - 1L)] <- 1 dimnames(x) <- list(names(cl), levels(cl)) x } m <- match.call(expand.dots = FALSE) if(is.matrix(eval.parent(m$data))) m$data <- as.data.frame(data) m$... <- m$contrasts <- NULL m[[1L]] <- as.name("model.frame") m <- eval.parent(m) Terms <- attr(m, "terms") x <- model.matrix(Terms, m, contrasts) cons <- attr(x, "contrast") xint <- match("(Intercept)", colnames(x), nomatch=0L) if(xint > 0L) x <- x[, -xint, drop=FALSE] # Bias term is used for intercepts w <- model.weights(m) if(length(w) == 0L) w <- rep(1, nrow(x)) y <- model.response(m) if(is.factor(y)) { lev <- levels(y) counts <- table(y) if(any(counts == 0L)) { empty <- lev[counts == 0L] warning(sprintf(ngettext(length(empty), "group %s is empty", "groups %s are empty"), paste(sQuote(empty), collapse=" ")), domain = NA) y <- factor(y, levels=lev[counts > 0L]) } if(length(lev) == 2L) { y <- as.vector(unclass(y)) - 1 res <- nnet.default(x, y, w, entropy=TRUE, ...) res$lev <- lev } else { y <- class.ind(y) res <- nnet.default(x, y, w, softmax=TRUE, ...) res$lev <- lev } } else res <- nnet.default(x, y, w, ...) res$terms <- Terms res$coefnames <- colnames(x) res$call <- match.call() res$na.action <- attr(m, "na.action") res$contrasts <- cons res$xlevels <- .getXlevels(Terms, m) class(res) <- c("nnet.formula", "nnet") res } nnet.default <- function(x, y, weights, size, Wts, mask=rep(TRUE, length(wts)), linout=FALSE, entropy=FALSE, softmax=FALSE, censored=FALSE, skip=FALSE, rang=0.7, decay=0, maxit=100, Hess=FALSE, trace=TRUE, MaxNWts=1000, abstol=1.0e-4, reltol=1.0e-8, ...) { net <- NULL x <- as.matrix(x) y <- as.matrix(y) if(any(is.na(x))) stop("missing values in 'x'") if(any(is.na(y))) stop("missing values in 'y'") if(dim(x)[1L] != dim(y)[1L]) stop("nrows of 'x' and 'y' must match") if(linout && entropy) stop("entropy fit only for logistic units") if(softmax) { linout <- TRUE entropy <- FALSE } if(censored) { linout <- TRUE entropy <- FALSE softmax <- TRUE } net$n <- c(dim(x)[2L], size, dim(y)[2L]) net$nunits <- as.integer(1L + sum(net$n)) net$nconn <- rep(0, net$nunits+1L) net$conn <- numeric(0L) net <- norm.net(net) if(skip) net <- add.net(net, seq(1L,net$n[1L]), seq(1L+net$n[1L]+net$n[2L], net$nunits-1L)) if((nwts <- length(net$conn))==0) stop("no weights to fit") if(nwts > MaxNWts) stop(gettextf("too many (%d) weights", nwts), domain=NA) nsunits <- net$nunits if(linout) nsunits <- net$nunits - net$n[3L] net$nsunits <- nsunits net$decay <- decay net$entropy <- entropy if(softmax && NCOL(y) < 2L) stop("'softmax = TRUE' requires at least two response categories") net$softmax <- softmax net$censored <- censored if(missing(Wts)) if(rang > 0) wts <- runif(nwts, -rang, rang) else wts <- rep(0, nwts) else wts <- Wts if(length(wts) != nwts) stop("weights vector of incorrect length") if(length(mask) != length(wts)) stop("incorrect length of 'mask'") if(trace) { cat("# weights: ", length(wts)) # nw <- sum(mask != 0) if(nw < length(wts)) cat(" (", nw, " variable)\n",sep="") else cat("\n") flush.console() } if(length(decay) == 1L) decay <- rep(decay, length(wts)) .C(VR_set_net, as.integer(net$n), as.integer(net$nconn), as.integer(net$conn), as.double(decay), as.integer(nsunits), as.integer(entropy), as.integer(softmax), as.integer(censored) ) ntr <- dim(x)[1L] nout <- dim(y)[2L] if(missing(weights)) weights <- rep(1, ntr) if(length(weights) != ntr || any(weights < 0)) stop("invalid weights vector") Z <- as.double(cbind(x,y)) storage.mode(weights) <- "double" tmp <- .C(VR_dovm, as.integer(ntr), Z, weights, as.integer(length(wts)), wts=as.double(wts), val=double(1), as.integer(maxit), as.logical(trace), as.integer(mask), as.double(abstol), as.double(reltol), ifail = integer(1L) ) net$value <- tmp$val net$wts <- tmp$wts net$convergence <- tmp$ifail tmp <- matrix(.C(VR_nntest, as.integer(ntr), Z, tclass = double(ntr*nout), as.double(net$wts))$tclass, ntr, nout) dimnames(tmp) <- list(rownames(x), colnames(y)) net$fitted.values <- tmp tmp <- y - tmp dimnames(tmp) <- list(rownames(x), colnames(y)) net$residuals <- tmp .C(VR_unset_net) if(entropy) net$lev <- c("0","1") if(softmax) net$lev <- colnames(y) net$call <- match.call() if(Hess) net$Hessian <- nnetHess(net, x, y, weights) class(net) <- "nnet" net } predict.nnet <- function(object, newdata, type=c("raw","class"), ...) { if(!inherits(object, "nnet")) stop("object not of class \"nnet\"") type <- match.arg(type) if(missing(newdata)) z <- fitted(object) else { if(inherits(object, "nnet.formula")) { # ## formula fit newdata <- as.data.frame(newdata) rn <- row.names(newdata) ## work hard to predict NA for rows with missing data Terms <- delete.response(object$terms) m <- model.frame(Terms, newdata, na.action = na.omit, xlev = object$xlevels) if (!is.null(cl <- attr(Terms, "dataClasses"))) .checkMFClasses(cl, m) keep <- match(row.names(m), rn) x <- model.matrix(Terms, m, contrasts = object$contrasts) xint <- match("(Intercept)", colnames(x), nomatch=0L) if(xint > 0L) x <- x[, -xint, drop=FALSE] # Bias term is used for intercepts } else { ## matrix ... fit if(is.null(dim(newdata))) dim(newdata) <- c(1L, length(newdata)) # a row vector x <- as.matrix(newdata) # to cope with dataframes if(any(is.na(x))) stop("missing values in 'x'") keep <- 1L:nrow(x) rn <- rownames(x) } ntr <- nrow(x) nout <- object$n[3L] .C(VR_set_net, as.integer(object$n), as.integer(object$nconn), as.integer(object$conn), rep(0.0, length(object$wts)), as.integer(object$nsunits), as.integer(0L), as.integer(object$softmax), as.integer(object$censored)) z <- matrix(NA, nrow(newdata), nout, dimnames = list(rn, dimnames(object$fitted.values)[[2L]])) z[keep, ] <- matrix(.C(VR_nntest, as.integer(ntr), as.double(x), tclass = double(ntr*nout), as.double(object$wts) )$tclass, ntr, nout) .C(VR_unset_net) } switch(type, raw = z, class = { if(is.null(object$lev)) stop("inappropriate fit for class") if(ncol(z) > 1L) object$lev[max.col(z)] else object$lev[1L + (z > 0.5)] }) } eval.nn <- function(wts) { z <- .C(VR_dfunc, as.double(wts), df = double(length(wts)), fp = as.double(1)) fp <- z$fp attr(fp, "gradient") <- z$df fp } add.net <- function(net, from, to) { nconn <- net$nconn conn <- net$conn for(i in to){ ns <- nconn[i+2L] cadd <- from if(nconn[i+1] == ns) cadd <- c(0,from) con <- NULL if(ns > 1L) con <- conn[1L:ns] con <- c(con, cadd) if(length(conn) > ns) con <- c(con, conn[(ns+1L):length(conn)]) for(j in (i+1L):net$nunits) nconn[j+1L] <- nconn[j+1L]+length(cadd) conn <- con } net$nconn <- nconn net$conn <- con net } norm.net <- function(net) { n <- net$n; n0 <- n[1L]; n1 <- n0+n[2L]; n2 <- n1+n[3L]; if(n[2L] <= 0) return(net) net <- add.net(net, 1L:n0,(n0+1L):n1) add.net(net, (n0+1L):n1, (n1+1L):n2) } which.is.max <- function(x) { y <- seq_along(x)[x == max(x)] if(length(y) > 1L) sample(y, 1L) else y } nnetHess <- function(net, x, y, weights) { x <- as.matrix(x) y <- as.matrix(y) if(dim(x)[1L] != dim(y)[1L]) stop("dims of 'x' and 'y' must match") nw <- length(net$wts) decay <- net$decay if(length(decay) == 1) decay <- rep(decay, nw) .C(VR_set_net, as.integer(net$n), as.integer(net$nconn), as.integer(net$conn), as.double(decay), as.integer(net$nsunits), as.integer(net$entropy), as.integer(net$softmax), as.integer(net$censored) ) ntr <- dim(x)[1L] if(missing(weights)) weights <- rep(1, ntr) if(length(weights) != ntr || any(weights < 0)) stop("invalid weights vector") Z <- as.double(cbind(x,y)) storage.mode(weights) <- "double" z <- matrix(.C(VR_nnHessian, as.integer(ntr), Z, weights, as.double(net$wts), H = double(nw*nw))$H, nw, nw) .C(VR_unset_net) z } class.ind <- function(cl) { n <- length(cl) cl <- as.factor(cl) x <- matrix(0, n, length(levels(cl)) ) x[(1L:n) + n*(unclass(cl)-1L)] <- 1 dimnames(x) <- list(names(cl), levels(cl)) x } print.nnet <- function(x, ...) { if(!inherits(x, "nnet")) stop("not a legitimate neural net fit") cat("a ",x$n[1L],"-",x$n[2L],"-",x$n[3L]," network", sep="") cat(" with", length(x$wts),"weights\n") if(length(x$coefnames)) cat("inputs:", x$coefnames, "\noutput(s):", deparse(formula(x)[[2L]], backtick=TRUE), "\n") cat("options were -") tconn <- diff(x$nconn) if(tconn[length(tconn)] > x$n[2L]+1L) cat(" skip-layer connections ") if(x$nunits > x$nsunits && !x$softmax) cat(" linear output units ") if(x$entropy) cat(" entropy fitting ") if(x$softmax) cat(" softmax modelling ") if(x$decay[1L] > 0) cat(" decay=", x$decay[1L], sep="") cat("\n") invisible(x) } coef.nnet <- function(object, ...) { wts <- object$wts wm <- c("b", paste("i", seq_len(object$n[1L]), sep="")) if(object$n[2L] > 0L) wm <- c(wm, paste("h", seq_len(object$n[2L]), sep="")) if(object$n[3L] > 1L) wm <- c(wm, paste("o", seq_len(object$n[3L]), sep="")) else wm <- c(wm, "o") names(wts) <- apply(cbind(wm[1+object$conn], wm[1L+rep(1L:object$nunits - 1L, diff(object$nconn))]), 1L, function(x) paste(x, collapse = "->")) wts } summary.nnet <- function(object, ...) { class(object) <- c("summary.nnet", class(object)) object } print.summary.nnet <- function(x, ...) { cat("a ",x$n[1L],"-",x$n[2L],"-",x$n[3L]," network", sep="") cat(" with", length(x$wts),"weights\n") cat("options were -") tconn <- diff(x$nconn) if(tconn[length(tconn)] > x$n[2L]+1L) cat(" skip-layer connections ") if(x$nunits > x$nsunits && !x$softmax) cat(" linear output units ") if(x$entropy) cat(" entropy fitting ") if(x$softmax) cat(" softmax modelling ") if(x$decay[1L] > 0) cat(" decay=", x$decay[1L], sep="") cat("\n") wts <- format(round(coef.nnet(x),2)) lapply(split(wts, rep(1L:x$nunits, tconn)), function(x) print(x, quote=FALSE)) invisible(x) } # residuals.nnet <- function(object, ...) object$residuals nnet/R/vcovmultinom.R0000644000176000001440000000411111754561330014336 0ustar ripleyusers# file nnet/vcovmultinom.R # copyright (c) 2003 B. D. Ripley # Use of analytic Fisher information contributed by David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ # multinomHess <- function(object, Z = model.matrix(object)) { probs <- fitted(object) coefs <- coef(object) if (is.vector(coefs)){ # ie there are only 2 response categories coefs <- t(as.matrix(coefs)) probs <- cbind(1 - probs, probs) } coefdim <- dim(coefs) p <- coefdim[2L] k <- coefdim[1L] ncoefs <- k * p kpees <- rep(p, k) n <- dim(Z)[1L] ## Now compute the observed (= expected, in this case) information, ## e.g. as in T Amemiya "Advanced Econometrics" (1985) pp295-6. ## Here i and j are as in Amemiya, and x, xbar are vectors ## specific to (i,j) and to i respectively. info <- matrix(0, ncoefs, ncoefs) Names <- dimnames(coefs) if (is.null(Names[[1L]])) Names <- Names[[2L]] else Names <- as.vector(outer(Names[[2L]], Names[[1L]], function(name2, name1) paste(name1, name2, sep = ":"))) dimnames(info) <- list(Names, Names) x0 <- matrix(0, p, k+1) row.totals <- object$weights for (i in 1L:n){ Zi <- Z[i, ] xbar <- Zi * rep(probs[i, -1, drop=FALSE], kpees) for (j in 1L:(k+1)){ x <- x0 x[, j] <- Zi x <- x[, -1, drop = FALSE] x <- x - xbar dim(x) <- c(1, ncoefs) info <- info + (row.totals[i] * probs[i, j] * crossprod(x)) } } info } nnet/R/zzz.R0000644000176000001440000000013611754561330012434 0ustar ripleyusers.noGenerics <- TRUE .onUnload <- function(libpath) library.dynam.unload("nnet", libpath) nnet/inst/0000755000176000001440000000000012164263257012233 5ustar ripleyusersnnet/inst/CITATION0000644000176000001440000000127411754561331013372 0ustar ripleyuserscitHeader("To cite the nnet package in publications use:") citEntry(entry="Book", title = "Modern Applied Statistics with S", author = personList(as.person("W. N. Venables"), as.person("B. D. Ripley")), publisher = "Springer", edition = "Fourth", address = "New York", year = 2002, note = "ISBN 0-387-95457-0", url = "http://www.stats.ox.ac.uk/pub/MASS4", textVersion = paste("Venables, W. N. & Ripley, B. D. (2002)", "Modern Applied Statistics with S.", "Fourth Edition. Springer, New York. ISBN 0-387-95457-0") )nnet/inst/NEWS0000644000176000001440000000225711754561331012736 0ustar ripleyusersSoftware and datasets to support 'Modern Applied Statistics with S', fourth edition, by W. N. Venables and B. D. Ripley. Springer, 2002, ISBN 0-387-95457-0. This file documents software changes since the third edition. - no copying of datasets even in R. - model.frame method for multinom (even in R). - nnet now uses the C interface to optim. - nnet.Hess has been renamed nnetHess. - vcov.multinom now computes the Hessian analytically (thanks to David Firth). - predict methods for multinom, nnet now check newdata types - model.frame.multinom now looks for the environment of the original formula - multinom has a new `model' argument defaulting to TRUE. - the multinom methods for add1, dropterm and anova now check for changes in the number of cases in use caused e.g. by na.action=na.omit. - added confint() method for multinom. - added logLik() method for multinom. - summary() for multinom now defaults to correlation=FALSE. - nnet() reports on 'convergence'. - confint.multinom() works better with a non-default 'parm'. - multinom() and nnet(softmax=TRUE) give an explicit error message for one-category responses. - the loglik() method for multinom() returns an "nobs" attribute. nnet/inst/po/0000755000176000001440000000000012121561440012635 5ustar ripleyusersnnet/inst/po/de/0000755000176000001440000000000011754561331013237 5ustar ripleyusersnnet/inst/po/de/LC_MESSAGES/0000755000176000001440000000000012023424654015020 5ustar ripleyusersnnet/inst/po/de/LC_MESSAGES/R-nnet.mo0000644000176000001440000000563412121561440016522 0ustar ripleyusers%P&Q:x7# %.Tp60(Lu'9>Yw"4P<K3-B'p& S t F 3  & (G 1p - G " &; b "y      'scope' is not a subset of term labels'softmax = TRUE' requires at least two response categoriesanova is not implemented for a single "multinom" objectdims of 'x' and 'y' must matchentropy fit only for logistic unitsgroup %s is emptygroups %s are emptyinappropriate fit for classincorrect length of 'mask'invalid weights vectormissing values in 'x'missing values in 'y'models were not all fitted to the same size of datasetncol(offset) is wrongneed two or more classes to fit a multinom modelno terms in 'scope' for adding to objectno weights to fitnot a "multinom" fitnot a legitimate neural net fitnot all objects are of class "multinom"nrows of 'x' and 'y' must matchnumber of rows in use has changed: remove missing values?object not of class "nnet"some case has no observationstoo many (%d) weightsweights vector of incorrect lengthProject-Id-Version: R 2.15.2 / nnet 7.3-5 Report-Msgid-Bugs-To: bugs@r-project.org POT-Creation-Date: 2012-06-27 09:25 PO-Revision-Date: 2012-10-11 21:08+0200 Last-Translator: Chris Leick Language-Team: German Language: de MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n != 1); 'scope' ist keine Untermenge der Termbeschriftungen.'softmax = TRUE' benötigt mindestens zwei AntwortkategorienVarianzanalyse ist nicht für ein einzelnes "multinom"-Objekt implementiertDimensionen von 'x' und 'y' müssen übereinstimmenEntropie passt nur für logistische EinheitenGruppe %s ist leerGruppen %s sind leerunangemessene Passform für die Klassefalsche Länge von 'mask'ungültiger Gewichtsvektorfehlende Werte in 'x'fehlende Werte in 'y'Nicht alle Modelle wurden an die gleiche Größe wie die des Datensatzes angepasst.ncol(Versatz) ist falschzwei oder mehr Klassen sind nötig, um multinomiales Modell anzupassenkeine Terme in 'scope', um ein Objekt hinzuzufügenkeine Gewichte für Anpassungkeine "multinom"-Anpassungsgütekeine rechtmäßige neuronale Netz-Gütenicht alle Objekte gehören zur Klasse "multinom"nrows von 'x' und 'y' müssen übereinstimmenZahl der benutzten Zeilen hat sich geändert: fehlende Werte entfernen?Objekt nicht aus der Klasse "nnet"irgendein Fall hat keine Beobachtungenzu viele (%d) GewichteGewichtsvektor von falscher Längennet/inst/po/en@quot/0000755000176000001440000000000011754561331014262 5ustar ripleyusersnnet/inst/po/en@quot/LC_MESSAGES/0000755000176000001440000000000011772553043016050 5ustar ripleyusersnnet/inst/po/en@quot/LC_MESSAGES/R-nnet.mo0000644000176000001440000000515512121561440017543 0ustar ripleyusers%P&Q:x7# %.Tp60(Lu'9>Yw"5*>7P&#%4Ke60,* < Q 'q ' 9   4 "J      'scope' is not a subset of term labels'softmax = TRUE' requires at least two response categoriesanova is not implemented for a single "multinom" objectdims of 'x' and 'y' must matchentropy fit only for logistic unitsgroup %s is emptygroups %s are emptyinappropriate fit for classincorrect length of 'mask'invalid weights vectormissing values in 'x'missing values in 'y'models were not all fitted to the same size of datasetncol(offset) is wrongneed two or more classes to fit a multinom modelno terms in 'scope' for adding to objectno weights to fitnot a "multinom" fitnot a legitimate neural net fitnot all objects are of class "multinom"nrows of 'x' and 'y' must matchnumber of rows in use has changed: remove missing values?object not of class "nnet"some case has no observationstoo many (%d) weightsweights vector of incorrect lengthProject-Id-Version: nnet 7.3-5 POT-Creation-Date: 2012-10-08 10:54 PO-Revision-Date: 2012-10-08 10:54 Last-Translator: Automatically generated Language-Team: none MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Language: en Plural-Forms: nplurals=2; plural=(n != 1); ‘scope’ is not a subset of term labels‘softmax = TRUE’ requires at least two response categoriesanova is not implemented for a single "multinom" objectdims of ‘x’ and ‘y’ must matchentropy fit only for logistic unitsgroup %s is emptygroups %s are emptyinappropriate fit for classincorrect length of ‘mask’invalid weights vectormissing values in ‘x’missing values in ‘y’models were not all fitted to the same size of datasetncol(offset) is wrongneed two or more classes to fit a multinom modelno terms in ‘scope’ for adding to objectno weights to fitnot a "multinom" fitnot a legitimate neural net fitnot all objects are of class "multinom"nrows of ‘x’ and ‘y’ must matchnumber of rows in use has changed: remove missing values?object not of class "nnet"some case has no observationstoo many (%d) weightsweights vector of incorrect lengthnnet/inst/po/fr/0000755000176000001440000000000011754561331013256 5ustar ripleyusersnnet/inst/po/fr/LC_MESSAGES/0000755000176000001440000000000011772553043015044 5ustar ripleyusersnnet/inst/po/fr/LC_MESSAGES/R-nnet.mo0000644000176000001440000000600512121561440016532 0ustar ripleyusers%P&Q:x7# %.Tp60(Lu'9>Yw";`<;4FJ/(! , H Bd  F , 4 %R 8x 1 8 O "l %  5      'scope' is not a subset of term labels'softmax = TRUE' requires at least two response categoriesanova is not implemented for a single "multinom" objectdims of 'x' and 'y' must matchentropy fit only for logistic unitsgroup %s is emptygroups %s are emptyinappropriate fit for classincorrect length of 'mask'invalid weights vectormissing values in 'x'missing values in 'y'models were not all fitted to the same size of datasetncol(offset) is wrongneed two or more classes to fit a multinom modelno terms in 'scope' for adding to objectno weights to fitnot a "multinom" fitnot a legitimate neural net fitnot all objects are of class "multinom"nrows of 'x' and 'y' must matchnumber of rows in use has changed: remove missing values?object not of class "nnet"some case has no observationstoo many (%d) weightsweights vector of incorrect lengthProject-Id-Version: nnet 7.2-20 Report-Msgid-Bugs-To: bugs@r-project.org POT-Creation-Date: 2012-06-27 09:25 PO-Revision-Date: 2012-10-03 14:20+0100 Last-Translator: Philippe Grosjean Language-Team: French Language: fr MIME-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n > 1); X-Generator: Poedit 1.5.3 'scope' n'est pas un sous-ensemble des tiquettes de termes'softmax = TRUE' ncessite au moins deux catgories rponsesl'ANOVA n'est pas implmente pour un seul objet "multinom"les dimensions de 'x' et de 'y' doivent correspondreajustement entropique seulement pour des units de courbes logistiquesle groupe %s est videles groupes %s sont videsajustement inappropri pour cette classelongueur incorrecte pour 'mask'vecteur de pondrations incorrectvaleurs manquantes dans 'x'valeurs manquantes dans 'y'tous les modles n'ont pas t ajusts la mme taille de donnesncol(offset) est mauvaisau moins deux classes sont ncessaires pour ajuster un modle multinomaucun terme dans 'scope' ajouter l'objetpas de pondrations ajusterce n'est pas un ajustement "multinom"ce n'est pas un ajustement de rseau de neurone autoristous les objets doivent tre de classe "multinom"les nombres de lignes de 'x' et 'y' doivent correspondrele nombre de lignes en utilisation a chang : liminer les valeurs manquantes ?l'objet n'est pas de classe "nnet"quelques cas n'ont pas d'observationstrop (%d) de pondrationsle vecteur de pondrations est de longueur incorrectennet/inst/po/ko/0000755000176000001440000000000012121561440013246 5ustar ripleyusersnnet/inst/po/ko/LC_MESSAGES/0000755000176000001440000000000012121561440015033 5ustar ripleyusersnnet/inst/po/ko/LC_MESSAGES/R-nnet.mo0000644000176000001440000000475312121561440016544 0ustar ripleyusersL&:7#[%z0E'Z9"86QGD6)5+_##)_!]8P_ *i * +      'scope' is not a subset of term labels'softmax = TRUE' requires at least two response categoriesanova is not implemented for a single "multinom" objectdims of 'x' and 'y' must matchgroup %s is emptygroups %s are emptyincorrect length of 'mask'invalid weights vectormissing values in 'x'missing values in 'y'ncol(offset) is wrongneed two or more classes to fit a multinom modelnot a "multinom" fitnot all objects are of class "multinom"nrows of 'x' and 'y' must matchnumber of rows in use has changed: remove missing values?object not of class "nnet"some case has no observationsweights vector of incorrect lengthProject-Id-Version: nnet 7.3-5 POT-Creation-Date: 2012-10-08 10:54 PO-Revision-Date: 2013-03-11 13:52-0600 Last-Translator: Chel Hee Lee Language-Team: R Development Translation Teams (Korean) Language: ko MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=1; plural=0; X-Poedit-Language: Korean X-Poedit-Country: KOREA, REPUBLIC OF X-Poedit-SourceCharset: utf-8 'scope'는 term labels의 부분집합이 아닙니다'softmax = TRUE'는 적어도 두개의 response categories들이 요구됩니다anova는 단일 "multinom" 객체에는 구현되지 않았습니다'x'와 'y'의 dims는 반드시 일치해야 합니다그룹 %s는 비어있습니다'mask'의 길이가 잘못되었습니다유효하지 않은 weights vector입니다'x'에 결측치들이 있습니다'y'에 결측치들이 있습니다ncol(offset)가 올바르지 않습니다multinomial model을 적합하기 위해서는 두개 이상의 클래스들이 필요합니다"multinom" 적합이 아닙니다모든 객체들이 "multinom" 클래스는 아닙니다'x'의 행의 개수와 'y'의 행의 개수는 반드시 일치해야 합니다사용중인 행들의 개수가 변경되었습니다: 결측치들을 삭제하시겠나요?클래스 "nnet"가 가진 객체입니다어떤 경우는 관측치가 없습니다잘못된 길이의 weights vector입니다nnet/inst/po/pl/0000755000176000001440000000000011772553043013263 5ustar ripleyusersnnet/inst/po/pl/LC_MESSAGES/0000755000176000001440000000000011772553043015050 5ustar ripleyusersnnet/inst/po/pl/LC_MESSAGES/R-nnet.mo0000644000176000001440000000603112121561440016535 0ustar ripleyusers%P&Q:x7# %.Tp60(Lu'9>Yw"-GC9-}69! > \ s  N  B .X  " 2 ) 2 GR  (  $      'scope' is not a subset of term labels'softmax = TRUE' requires at least two response categoriesanova is not implemented for a single "multinom" objectdims of 'x' and 'y' must matchentropy fit only for logistic unitsgroup %s is emptygroups %s are emptyinappropriate fit for classincorrect length of 'mask'invalid weights vectormissing values in 'x'missing values in 'y'models were not all fitted to the same size of datasetncol(offset) is wrongneed two or more classes to fit a multinom modelno terms in 'scope' for adding to objectno weights to fitnot a "multinom" fitnot a legitimate neural net fitnot all objects are of class "multinom"nrows of 'x' and 'y' must matchnumber of rows in use has changed: remove missing values?object not of class "nnet"some case has no observationstoo many (%d) weightsweights vector of incorrect lengthProject-Id-Version: nnet 7.3-1 Report-Msgid-Bugs-To: bugs@r-project.org POT-Creation-Date: 2012-07-14 16:37 PO-Revision-Date: 2012-09-24 21:21+0100 Last-Translator: Łukasz Daniel Language-Team: Łukasz Daniel Language: pl_PL MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2); X-Poedit-SourceCharset: iso-8859-1 X-Generator: Poedit 1.5.3 'scope' nie jest podzbiorem etykiet członów'softmax = TRUE' wymaga co najmniej dwóch kategorii zmiennej zależnejanova nie jest zaimplementowana dla pojedynczego obiektu "multinom"wymiary dla 'x' oraz 'y' muszą się zgadzaćdopasowanie entropii tylko dla jednostek logistycznychgrupa %s jest pustagrupy %s są pustegrupy %s są pusteniepoprawne dopasowanie dla klasyniepoprawna długość 'mask'niepoprawny wektor wagbrakujące wartości w 'x'brakujące wartości w 'y'nie wszystkie modele zostały dopasowane do zbioru danych tego samego rozmiaru'ncol(offset)' jest błędnypotrzeba dwóch lub więcej klas aby dopasować model wielomianowybrak członów w 'scope' do dodania do obiektubrak wag do dopasowaniato nie jest dopasowanie "multinom"to nie jest poprawne dopasowanie sieci neuronowychnie wszystkie obiekt są klasy "multinom"liczby wierszy dla 'x' oraz 'y' muszą być zgodneliczba wierszy w użyciu zmieniła się: usunąć brakujące wartości?obiekt nie jest klasy "nnet"niektóre przypadki nie mają obserwacjizbyt dużo (%d) wagwektor wag o niepoprawnej długościnnet/man/0000755000176000001440000000000011754561331012027 5ustar ripleyusersnnet/man/class.ind.Rd0000644000176000001440000000150511754561331014175 0ustar ripleyusers% file nnet/man/class.ind.Rd % copyright (C) 1994-9 W. N. Venables and B. D. Ripley % \name{class.ind} \alias{class.ind} \title{ Generates Class Indicator Matrix from a Factor } \description{ Generates a class indicator function from a given factor. } \usage{ class.ind(cl) } \arguments{ \item{cl}{ factor or vector of classes for cases. }} \value{ a matrix which is zero except for the column corresponding to the class. } \references{ Venables, W. N. and Ripley, B. D. (2002) \emph{Modern Applied Statistics with S.} Fourth edition. Springer. } \examples{ # The function is currently defined as class.ind <- function(cl) { n <- length(cl) cl <- as.factor(cl) x <- matrix(0, n, length(levels(cl)) ) x[(1:n) + n*(unclass(cl)-1)] <- 1 dimnames(x) <- list(names(cl), levels(cl)) x } } \keyword{neural} \keyword{utilities} nnet/man/multinom.Rd0000644000176000001440000000730011754561331014162 0ustar ripleyusers% file nnet/man/multinom.Rd % copyright (C) 1994-2006 W. N. Venables and B. D. Ripley % \name{multinom} \alias{multinom} \alias{add1.multinom} \alias{anova.multinom} \alias{coef.multinom} \alias{drop1.multinom} \alias{extractAIC.multinom} \alias{predict.multinom} \alias{print.multinom} \alias{summary.multinom} \alias{print.summary.multinom} \alias{vcov.multinom} \alias{model.frame.multinom} \alias{logLik.multinom} \concept{multiple logistic} \title{ Fit Multinomial Log-linear Models } \description{ Fits multinomial log-linear models via neural networks. } \usage{ multinom(formula, data, weights, subset, na.action, contrasts = NULL, Hess = FALSE, summ = 0, censored = FALSE, model = FALSE, \dots) } \arguments{ \item{formula}{ a formula expression as for regression models, of the form \code{response ~ predictors}. The response should be a factor or a matrix with K columns, which will be interpreted as counts for each of K classes. A log-linear model is fitted, with coefficients zero for the first class. An offset can be included: it should be a numeric matrix with K columns if the response is either a matrix with K columns or a factor with K > 2 classes, or a numeric vector for a response factor with 2 levels. See the documentation of \code{\link{formula}()} for other details. } \item{data}{ an optional data frame in which to interpret the variables occurring in \code{formula}. } \item{weights}{ optional case weights in fitting. } \item{subset}{ expression saying which subset of the rows of the data should be used in the fit. All observations are included by default. } \item{na.action}{ a function to filter missing data. } \item{contrasts}{ a list of contrasts to be used for some or all of the factors appearing as variables in the model formula. } \item{Hess}{ logical for whether the Hessian (the observed/expected information matrix) should be returned. } \item{summ}{ integer; if non-zero summarize by deleting duplicate rows and adjust weights. Methods 1 and 2 differ in speed (2 uses \code{C}); method 3 also combines rows with the same X and different Y, which changes the baseline for the deviance. } \item{censored}{ If Y is a matrix with \code{K > 2} columns, interpret the entries as one for possible classes, zero for impossible classes, rather than as counts. } \item{model}{ logical. If true, the model frame is saved as component \code{model} of the returned object. } \item{\dots}{ additional arguments for \code{nnet} }} \details{ \code{multinom} calls \code{\link{nnet}}. The variables on the rhs of the formula should be roughly scaled to [0,1] or the fit will be slow or may not converge at all. } \value{ A \code{nnet} object with additional components: \item{deviance}{ the residual deviance, compared to the full saturated model (that explains individual observations exactly). Also, minus twice log-likelihood. } \item{edf}{ the (effective) number of degrees of freedom used by the model } \item{AIC}{ the AIC for this fit. } \item{Hessian}{ (if \code{Hess} is true). } \item{model}{ (if \code{model} is true). }} \references{ Venables, W. N. and Ripley, B. D. (2002) \emph{Modern Applied Statistics with S.} Fourth edition. Springer. } \seealso{ \code{\link{nnet}} } \examples{ options(contrasts = c("contr.treatment", "contr.poly")) library(MASS) example(birthwt) (bwt.mu <- multinom(low ~ ., bwt)) \dontrun{Call: multinom(formula = low ~ ., data = bwt) Coefficients: (Intercept) age lwt raceblack raceother 0.823477 -0.03724311 -0.01565475 1.192371 0.7406606 smoke ptd ht ui ftv1 ftv2+ 0.7555234 1.343648 1.913213 0.6802007 -0.4363238 0.1789888 Residual Deviance: 195.4755 AIC: 217.4755 } } \keyword{neural} \keyword{models} nnet/man/nnet.Hess.Rd0000644000176000001440000000255311754561331014170 0ustar ripleyusers% file nnet/man/nnet.Hess.Rd % copyright (C) 1994-2000 W. N. Venables and B. D. Ripley % \name{nnetHess} \alias{nnetHess} \title{ Evaluates Hessian for a Neural Network } \description{ Evaluates the Hessian (matrix of second derivatives) of the specified neural network. Normally called via argument \code{Hess=TRUE} to \code{nnet} or via \code{vcov.multinom}. } \usage{ nnetHess(net, x, y, weights) } \arguments{ \item{net}{ object of class \code{nnet} as returned by \code{nnet}. } \item{x}{ training data. } \item{y}{ classes for training data. } \item{weights}{ the (case) weights used in the \code{nnet} fit. }} \value{ square symmetric matrix of the Hessian evaluated at the weights stored in the net. } \references{ Ripley, B. D. (1996) \emph{Pattern Recognition and Neural Networks.} Cambridge. Venables, W. N. and Ripley, B. D. (2002) \emph{Modern Applied Statistics with S.} Fourth edition. Springer. } \seealso{ \code{\link{nnet}}, \code{\link{predict.nnet}} } \examples{ # use half the iris data ir <- rbind(iris3[,,1], iris3[,,2], iris3[,,3]) targets <- matrix(c(rep(c(1,0,0),50), rep(c(0,1,0),50), rep(c(0,0,1),50)), 150, 3, byrow=TRUE) samp <- c(sample(1:50,25), sample(51:100,25), sample(101:150,25)) ir1 <- nnet(ir[samp,], targets[samp,], size=2, rang=0.1, decay=5e-4, maxit=200) eigen(nnetHess(ir1, ir[samp,], targets[samp,]), TRUE)$values } \keyword{neural} nnet/man/nnet.Rd0000644000176000001440000001317411754561331013270 0ustar ripleyusers% file nnet/man/nnet.Rd % copyright (C) 1994-9 W. N. Venables and B. D. Ripley % \name{nnet} \alias{nnet} \alias{nnet.default} \alias{nnet.formula} \alias{add.net} \alias{norm.net} \alias{eval.nn} \alias{coef.nnet} \alias{print.nnet} % \alias{residuals.nnet} \alias{summary.nnet} \alias{print.summary.nnet} \title{ Fit Neural Networks } \description{ Fit single-hidden-layer neural network, possibly with skip-layer connections. } \usage{ nnet(x, \dots) \method{nnet}{formula}(formula, data, weights, \dots, subset, na.action, contrasts = NULL) \method{nnet}{default}(x, y, weights, size, Wts, mask, linout = FALSE, entropy = FALSE, softmax = FALSE, censored = FALSE, skip = FALSE, rang = 0.7, decay = 0, maxit = 100, Hess = FALSE, trace = TRUE, MaxNWts = 1000, abstol = 1.0e-4, reltol = 1.0e-8, \dots) } \arguments{ \item{formula}{ A formula of the form \code{class ~ x1 + x2 + \dots} } \item{x}{ matrix or data frame of \code{x} values for examples. } \item{y}{ matrix or data frame of target values for examples. } \item{weights}{ (case) weights for each example -- if missing defaults to 1. } \item{size}{ number of units in the hidden layer. Can be zero if there are skip-layer units. } \item{data}{ Data frame from which variables specified in \code{formula} are preferentially to be taken. } \item{subset}{ An index vector specifying the cases to be used in the training sample. (NOTE: If given, this argument must be named.) } \item{na.action}{ A function to specify the action to be taken if \code{NA}s are found. The default action is for the procedure to fail. An alternative is na.omit, which leads to rejection of cases with missing values on any required variable. (NOTE: If given, this argument must be named.) } \item{contrasts}{ a list of contrasts to be used for some or all of the factors appearing as variables in the model formula. } \item{Wts}{ initial parameter vector. If missing chosen at random. } \item{mask}{ logical vector indicating which parameters should be optimized (default all). } \item{linout}{ switch for linear output units. Default logistic output units. } \item{entropy}{ switch for entropy (= maximum conditional likelihood) fitting. Default by least-squares. } \item{softmax}{ switch for softmax (log-linear model) and maximum conditional likelihood fitting. \code{linout}, \code{entropy}, \code{softmax} and \code{censored} are mutually exclusive. } \item{censored}{ A variant on \code{softmax}, in which non-zero targets mean possible classes. Thus for \code{softmax} a row of \code{(0, 1, 1)} means one example each of classes 2 and 3, but for \code{censored} it means one example whose class is only known to be 2 or 3. } \item{skip}{ switch to add skip-layer connections from input to output. } \item{rang}{ Initial random weights on [-\code{rang}, \code{rang}]. Value about 0.5 unless the inputs are large, in which case it should be chosen so that \code{rang} * max(\code{|x|}) is about 1. } \item{decay}{ parameter for weight decay. Default 0. } \item{maxit}{ maximum number of iterations. Default 100. } \item{Hess}{ If true, the Hessian of the measure of fit at the best set of weights found is returned as component \code{Hessian}. } \item{trace}{ switch for tracing optimization. Default \code{TRUE}. } \item{MaxNWts}{ The maximum allowable number of weights. There is no intrinsic limit in the code, but increasing \code{MaxNWts} will probably allow fits that are very slow and time-consuming. } \item{abstol}{ Stop if the fit criterion falls below \code{abstol}, indicating an essentially perfect fit. } \item{reltol}{ Stop if the optimizer is unable to reduce the fit criterion by a factor of at least \code{1 - reltol}. } \item{\dots}{ arguments passed to or from other methods. }} \value{ object of class \code{"nnet"} or \code{"nnet.formula"}. Mostly internal structure, but has components \item{wts}{ the best set of weights found } \item{value}{ value of fitting criterion plus weight decay term. } \item{fitted.values}{ the fitted values for the training data. } \item{residuals}{ the residuals for the training data. } \item{convergence}{ \code{1} if the maximum number of iterations was reached, otherwise \code{0}. }} \details{ If the response in \code{formula} is a factor, an appropriate classification network is constructed; this has one output and entropy fit if the number of levels is two, and a number of outputs equal to the number of classes and a softmax output stage for more levels. If the response is not a factor, it is passed on unchanged to \code{nnet.default}. Optimization is done via the BFGS method of \code{\link{optim}}. } \references{ Ripley, B. D. (1996) \emph{Pattern Recognition and Neural Networks.} Cambridge. Venables, W. N. and Ripley, B. D. (2002) \emph{Modern Applied Statistics with S.} Fourth edition. Springer. } \seealso{ \code{\link{predict.nnet}}, \code{\link{nnetHess}} } \examples{ # use half the iris data ir <- rbind(iris3[,,1],iris3[,,2],iris3[,,3]) targets <- class.ind( c(rep("s", 50), rep("c", 50), rep("v", 50)) ) samp <- c(sample(1:50,25), sample(51:100,25), sample(101:150,25)) ir1 <- nnet(ir[samp,], targets[samp,], size = 2, rang = 0.1, decay = 5e-4, maxit = 200) test.cl <- function(true, pred) { true <- max.col(true) cres <- max.col(pred) table(true, cres) } test.cl(targets[-samp,], predict(ir1, ir[-samp,])) # or ird <- data.frame(rbind(iris3[,,1], iris3[,,2], iris3[,,3]), species = factor(c(rep("s",50), rep("c", 50), rep("v", 50)))) ir.nn2 <- nnet(species ~ ., data = ird, subset = samp, size = 2, rang = 0.1, decay = 5e-4, maxit = 200) table(ird$species[-samp], predict(ir.nn2, ird[-samp,], type = "class")) } \keyword{neural} nnet/man/predict.nnet.Rd0000644000176000001440000000430611754561331014716 0ustar ripleyusers% file nnet/man/predict.nnet.Rd % copyright (C) 1994-9 W. N. Venables and B. D. Ripley % \name{predict.nnet} \alias{predict.nnet} \title{ Predict New Examples by a Trained Neural Net } \description{ Predict new examples by a trained neural net. } \usage{ \method{predict}{nnet}(object, newdata, type = c("raw","class"), \dots) } \arguments{ \item{object}{ an object of class \code{nnet} as returned by \code{nnet}. } \item{newdata}{ matrix or data frame of test examples. A vector is considered to be a row vector comprising a single case. } \item{type}{ Type of output } \item{\dots}{ arguments passed to or from other methods. }} \value{ If \code{type = "raw"}, the matrix of values returned by the trained network; if \code{type = "class"}, the corresponding class (which is probably only useful if the net was generated by \code{nnet.formula}). } \details{ This function is a method for the generic function \code{predict()} for class \code{"nnet"}. It can be invoked by calling \code{predict(x)} for an object \code{x} of the appropriate class, or directly by calling \code{predict.nnet(x)} regardless of the class of the object. } \references{ Ripley, B. D. (1996) \emph{Pattern Recognition and Neural Networks.} Cambridge. Venables, W. N. and Ripley, B. D. (2002) \emph{Modern Applied Statistics with S.} Fourth edition. Springer. } \seealso{ \code{\link{nnet}}, \code{\link{which.is.max}} } \examples{ # use half the iris data ir <- rbind(iris3[,,1], iris3[,,2], iris3[,,3]) targets <- class.ind( c(rep("s", 50), rep("c", 50), rep("v", 50)) ) samp <- c(sample(1:50,25), sample(51:100,25), sample(101:150,25)) ir1 <- nnet(ir[samp,], targets[samp,],size = 2, rang = 0.1, decay = 5e-4, maxit = 200) test.cl <- function(true, pred){ true <- max.col(true) cres <- max.col(pred) table(true, cres) } test.cl(targets[-samp,], predict(ir1, ir[-samp,])) # or ird <- data.frame(rbind(iris3[,,1], iris3[,,2], iris3[,,3]), species = factor(c(rep("s",50), rep("c", 50), rep("v", 50)))) ir.nn2 <- nnet(species ~ ., data = ird, subset = samp, size = 2, rang = 0.1, decay = 5e-4, maxit = 200) table(ird$species[-samp], predict(ir.nn2, ird[-samp,], type = "class")) } \keyword{neural} nnet/man/which.is.max.Rd0000644000176000001440000000131311754561331014614 0ustar ripleyusers% file nnet/R/which.is.max.Rd % copyright (C) 1994-9 W. N. Venables and B. D. Ripley % \name{which.is.max} \alias{which.is.max} \title{ Find Maximum Position in Vector } \description{ Find the maximum position in a vector, breaking ties at random. } \usage{ which.is.max(x) } \arguments{ \item{x}{ a vector }} \value{ index of a maximal value. } \details{ Ties are broken at random. } \seealso{ \code{\link{max.col}}, \code{\link{which.max}} which takes the first of ties. } \references{ Venables, W. N. and Ripley, B. D. (2002) \emph{Modern Applied Statistics with S.} Fourth edition. Springer. } \examples{ \dontrun{ pred <- predict(nnet, test) table(true, apply(pred,1,which.is.max)) }} \keyword{utilities} nnet/po/0000755000176000001440000000000012121561224011660 5ustar ripleyusersnnet/po/R-de.po0000644000176000001440000000617512035525433013026 0ustar ripleyusers# Translation of vr/R-nnet.pot to German # Copyright (C) 2007-2009 The R Foundation # This file is distributed under the same license as the lattice R package. # Chris Leick , 2009-2012. # Detlef Steuer , 2012. # msgid "" msgstr "" "Project-Id-Version: R 2.15.2 / nnet 7.3-5\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2012-06-27 09:25\n" "PO-Revision-Date: 2012-10-11 21:08+0200\n" "Last-Translator: Chris Leick \n" "Language-Team: German \n" "Language: de\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" msgid "need two or more classes to fit a multinom model" msgstr "zwei oder mehr Klassen sind nötig, um multinomiales Modell anzupassen" msgid "some case has no observations" msgstr "irgendein Fall hat keine Beobachtungen" msgid "ncol(offset) is wrong" msgstr "ncol(Versatz) ist falsch" msgid "not a \"multinom\" fit" msgstr "keine \"multinom\"-Anpassungsgüte" msgid "'scope' is not a subset of term labels" msgstr "'scope' ist keine Untermenge der Termbeschriftungen." msgid "number of rows in use has changed: remove missing values?" msgstr "Zahl der benutzten Zeilen hat sich geändert: fehlende Werte entfernen?" msgid "no terms in 'scope' for adding to object" msgstr "keine Terme in 'scope', um ein Objekt hinzuzufügen" msgid "anova is not implemented for a single \"multinom\" object" msgstr "" "Varianzanalyse ist nicht für ein einzelnes \"multinom\"-Objekt implementiert" msgid "not all objects are of class \"multinom\"" msgstr "nicht alle Objekte gehören zur Klasse \"multinom\"" msgid "models were not all fitted to the same size of dataset" msgstr "" "Nicht alle Modelle wurden an die gleiche Größe wie die des Datensatzes " "angepasst." msgid "missing values in 'x'" msgstr "fehlende Werte in 'x'" msgid "missing values in 'y'" msgstr "fehlende Werte in 'y'" msgid "nrows of 'x' and 'y' must match" msgstr "nrows von 'x' und 'y' müssen übereinstimmen" msgid "entropy fit only for logistic units" msgstr "Entropie passt nur für logistische Einheiten" msgid "no weights to fit" msgstr "keine Gewichte für Anpassung" msgid "too many (%d) weights" msgstr "zu viele (%d) Gewichte" msgid "'softmax = TRUE' requires at least two response categories" msgstr "'softmax = TRUE' benötigt mindestens zwei Antwortkategorien" msgid "weights vector of incorrect length" msgstr "Gewichtsvektor von falscher Länge" msgid "incorrect length of 'mask'" msgstr "falsche Länge von 'mask'" msgid "invalid weights vector" msgstr "ungültiger Gewichtsvektor" msgid "object not of class \"nnet\"" msgstr "Objekt nicht aus der Klasse \"nnet\"" msgid "inappropriate fit for class" msgstr "unangemessene Passform für die Klasse" msgid "dims of 'x' and 'y' must match" msgstr "Dimensionen von 'x' und 'y' müssen übereinstimmen" msgid "not a legitimate neural net fit" msgstr "keine rechtmäßige neuronale Netz-Güte" msgid "group %s is empty" msgid_plural "groups %s are empty" msgstr[0] "Gruppe %s ist leer" msgstr[1] "Gruppen %s sind leer" nnet/po/R-fr.po0000644000176000001440000000627012033026631013033 0ustar ripleyusers# Translation of R-nnet.pot to French # Copyright (C) 2005 The R Foundation # This file is distributed under the same license as the nnet R package. # Philippe Grosjean , 2005. # msgid "" msgstr "" "Project-Id-Version: nnet 7.2-20\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2012-06-27 09:25\n" "PO-Revision-Date: 2012-10-03 14:20+0100\n" "Last-Translator: Philippe Grosjean \n" "Language-Team: French \n" "Language: fr\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=ISO-8859-1\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" "X-Generator: Poedit 1.5.3\n" msgid "need two or more classes to fit a multinom model" msgstr "au moins deux classes sont ncessaires pour ajuster un modle multinom" msgid "some case has no observations" msgstr "quelques cas n'ont pas d'observations" msgid "ncol(offset) is wrong" msgstr "ncol(offset) est mauvais" msgid "not a \"multinom\" fit" msgstr "ce n'est pas un ajustement \"multinom\"" msgid "'scope' is not a subset of term labels" msgstr "'scope' n'est pas un sous-ensemble des tiquettes de termes" msgid "number of rows in use has changed: remove missing values?" msgstr "" "le nombre de lignes en utilisation a chang : liminer les valeurs " "manquantes ?" msgid "no terms in 'scope' for adding to object" msgstr "aucun terme dans 'scope' ajouter l'objet" msgid "anova is not implemented for a single \"multinom\" object" msgstr "l'ANOVA n'est pas implmente pour un seul objet \"multinom\"" msgid "not all objects are of class \"multinom\"" msgstr "tous les objets doivent tre de classe \"multinom\"" msgid "models were not all fitted to the same size of dataset" msgstr "tous les modles n'ont pas t ajusts la mme taille de donnes" msgid "missing values in 'x'" msgstr "valeurs manquantes dans 'x'" msgid "missing values in 'y'" msgstr "valeurs manquantes dans 'y'" msgid "nrows of 'x' and 'y' must match" msgstr "les nombres de lignes de 'x' et 'y' doivent correspondre" msgid "entropy fit only for logistic units" msgstr "ajustement entropique seulement pour des units de courbes logistiques" msgid "no weights to fit" msgstr "pas de pondrations ajuster" msgid "too many (%d) weights" msgstr "trop (%d) de pondrations" msgid "'softmax = TRUE' requires at least two response categories" msgstr "'softmax = TRUE' ncessite au moins deux catgories rponses" msgid "weights vector of incorrect length" msgstr "le vecteur de pondrations est de longueur incorrecte" msgid "incorrect length of 'mask'" msgstr "longueur incorrecte pour 'mask'" msgid "invalid weights vector" msgstr "vecteur de pondrations incorrect" msgid "object not of class \"nnet\"" msgstr "l'objet n'est pas de classe \"nnet\"" msgid "inappropriate fit for class" msgstr "ajustement inappropri pour cette classe" msgid "dims of 'x' and 'y' must match" msgstr "les dimensions de 'x' et de 'y' doivent correspondre" msgid "not a legitimate neural net fit" msgstr "ce n'est pas un ajustement de rseau de neurone autoris" msgid "group %s is empty" msgid_plural "groups %s are empty" msgstr[0] "le groupe %s est vide" msgstr[1] "les groupes %s sont vides" nnet/po/R-ko.po0000644000176000001440000000627012117506707013047 0ustar ripleyusers# Korean translation for R nnet package # Recommended/nnet/po/R-ko.po # Maintainer: Brian Ripley # Copyright (C) 1995-2013 The R Core Team # This file is distributed under the same license as the R nnet package. # R Development Translation Team - Korean # Chel Hee Lee , 2013. # Chel Hee Lee , 2013. # msgid "" msgstr "" "Project-Id-Version: nnet 7.3-5\n" "POT-Creation-Date: 2012-10-08 10:54\n" "PO-Revision-Date: 2013-03-11 13:52-0600\n" "Last-Translator: Chel Hee Lee \n" "Language-Team: R Development Translation Teams (Korean) \n" "Language: ko\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=1; plural=0;\n" "X-Poedit-Language: Korean\n" "X-Poedit-Country: KOREA, REPUBLIC OF\n" "X-Poedit-SourceCharset: utf-8\n" msgid "need two or more classes to fit a multinom model" msgstr "multinomial model을 적합하기 위해서는 두개 이상의 클래스들이 필요합니다" msgid "some case has no observations" msgstr "어떤 경우는 관측치가 없습니다" msgid "ncol(offset) is wrong" msgstr "ncol(offset)가 올바르지 않습니다" msgid "not a \"multinom\" fit" msgstr "\"multinom\" 적합이 아닙니다" msgid "'scope' is not a subset of term labels" msgstr "'scope'는 term labels의 부분집합이 아닙니다" msgid "number of rows in use has changed: remove missing values?" msgstr "사용중인 행들의 개수가 변경되었습니다: 결측치들을 삭제하시겠나요?" msgid "no terms in 'scope' for adding to object" msgstr "" msgid "anova is not implemented for a single \"multinom\" object" msgstr "anova는 단일 \"multinom\" 객체에는 구현되지 않았습니다" msgid "not all objects are of class \"multinom\"" msgstr "모든 객체들이 \"multinom\" 클래스는 아닙니다" msgid "models were not all fitted to the same size of dataset" msgstr "" msgid "missing values in 'x'" msgstr "'x'에 결측치들이 있습니다" msgid "missing values in 'y'" msgstr "'y'에 결측치들이 있습니다" msgid "nrows of 'x' and 'y' must match" msgstr "'x'의 행의 개수와 'y'의 행의 개수는 반드시 일치해야 합니다" msgid "entropy fit only for logistic units" msgstr "" msgid "no weights to fit" msgstr "" msgid "too many (%d) weights" msgstr "" msgid "'softmax = TRUE' requires at least two response categories" msgstr "'softmax = TRUE'는 적어도 두개의 response categories들이 요구됩니다" msgid "weights vector of incorrect length" msgstr "잘못된 길이의 weights vector입니다" msgid "incorrect length of 'mask'" msgstr "'mask'의 길이가 잘못되었습니다" msgid "invalid weights vector" msgstr "유효하지 않은 weights vector입니다" msgid "object not of class \"nnet\"" msgstr "클래스 \"nnet\"가 가진 객체입니다" msgid "inappropriate fit for class" msgstr "" msgid "dims of 'x' and 'y' must match" msgstr "'x'와 'y'의 dims는 반드시 일치해야 합니다" msgid "not a legitimate neural net fit" msgstr "" msgid "group %s is empty" msgid_plural "groups %s are empty" msgstr[0] "그룹 %s는 비어있습니다" nnet/po/R-nnet.pot0000644000176000001440000000327012034521306013551 0ustar ripleyusersmsgid "" msgstr "" "Project-Id-Version: nnet 7.3-5\n" "POT-Creation-Date: 2012-10-08 10:54\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "need two or more classes to fit a multinom model" msgstr "" msgid "some case has no observations" msgstr "" msgid "ncol(offset) is wrong" msgstr "" msgid "not a \"multinom\" fit" msgstr "" msgid "'scope' is not a subset of term labels" msgstr "" msgid "number of rows in use has changed: remove missing values?" msgstr "" msgid "no terms in 'scope' for adding to object" msgstr "" msgid "anova is not implemented for a single \"multinom\" object" msgstr "" msgid "not all objects are of class \"multinom\"" msgstr "" msgid "models were not all fitted to the same size of dataset" msgstr "" msgid "missing values in 'x'" msgstr "" msgid "missing values in 'y'" msgstr "" msgid "nrows of 'x' and 'y' must match" msgstr "" msgid "entropy fit only for logistic units" msgstr "" msgid "no weights to fit" msgstr "" msgid "too many (%d) weights" msgstr "" msgid "'softmax = TRUE' requires at least two response categories" msgstr "" msgid "weights vector of incorrect length" msgstr "" msgid "incorrect length of 'mask'" msgstr "" msgid "invalid weights vector" msgstr "" msgid "object not of class \"nnet\"" msgstr "" msgid "inappropriate fit for class" msgstr "" msgid "dims of 'x' and 'y' must match" msgstr "" msgid "not a legitimate neural net fit" msgstr "" msgid "group %s is empty" msgid_plural "groups %s are empty" msgstr[0] "" msgstr[1] "" nnet/po/R-pl.po0000644000176000001440000001270512033512602013035 0ustar ripleyusersmsgid "" msgstr "" "Project-Id-Version: nnet 7.3-1\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2012-07-14 16:37\n" "PO-Revision-Date: 2012-09-24 21:21+0100\n" "Last-Translator: Łukasz Daniel \n" "Language-Team: Łukasz Daniel \n" "Language: pl_PL\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 " "|| n%100>=20) ? 1 : 2);\n" "X-Poedit-SourceCharset: iso-8859-1\n" "X-Generator: Poedit 1.5.3\n" # nnet/R/multinom.R: 79 # stop("need two or more classes to fit a multinom model") msgid "need two or more classes to fit a multinom model" msgstr "potrzeba dwóch lub więcej klas aby dopasować model wielomianowy" # nnet/R/multinom.R: 115 # stop("some case has no observations") msgid "some case has no observations" msgstr "niektóre przypadki nie mają obserwacji" # nnet/R/multinom.R: 121 # stop("ncol(offset) is wrong") msgid "ncol(offset) is wrong" msgstr "'ncol(offset)' jest błędny" # nnet/R/multinom.R: 175 # stop("not a \"multinom\" fit") # nnet/R/multinom.R: 236 # stop("not a \"multinom\" fit") # nnet/R/multinom.R: 268 # stop("not a \"multinom\" fit") msgid "not a \"multinom\" fit" msgstr "to nie jest dopasowanie \"multinom\"" # nnet/R/multinom.R: 243 # stop("'scope' is not a subset of term labels") msgid "'scope' is not a subset of term labels" msgstr "'scope' nie jest podzbiorem etykiet członów" # nnet/R/multinom.R: 259 # stop("number of rows in use has changed: remove missing values?") # nnet/R/multinom.R: 289 # stop("number of rows in use has changed: remove missing values?") msgid "number of rows in use has changed: remove missing values?" msgstr "liczba wierszy w użyciu zmieniła się: usunąć brakujące wartości?" # nnet/R/multinom.R: 273 # stop("no terms in 'scope' for adding to object") msgid "no terms in 'scope' for adding to object" msgstr "brak członów w 'scope' do dodania do obiektu" # nnet/R/multinom.R: 386 # stop('anova is not implemented for a single "multinom" object') msgid "anova is not implemented for a single \"multinom\" object" msgstr "anova nie jest zaimplementowana dla pojedynczego obiektu \"multinom\"" # nnet/R/multinom.R: 395 # stop('not all objects are of class "multinom"') msgid "not all objects are of class \"multinom\"" msgstr "nie wszystkie obiekt są klasy \"multinom\"" # nnet/R/multinom.R: 398 # stop("models were not all fitted to the same size of dataset") msgid "models were not all fitted to the same size of dataset" msgstr "" "nie wszystkie modele zostały dopasowane do zbioru danych tego samego rozmiaru" # nnet/R/nnet.R: 84 # stop("missing values in 'x'") # nnet/R/nnet.R: 204 # stop("missing values in 'x'") msgid "missing values in 'x'" msgstr "brakujące wartości w 'x'" # nnet/R/nnet.R: 85 # stop("missing values in 'y'") msgid "missing values in 'y'" msgstr "brakujące wartości w 'y'" # nnet/R/nnet.R: 86 # stop("nrows of 'x' and 'y' must match") msgid "nrows of 'x' and 'y' must match" msgstr "liczby wierszy dla 'x' oraz 'y' muszą być zgodne" # nnet/R/nnet.R: 87 # stop("entropy fit only for logistic units") msgid "entropy fit only for logistic units" msgstr "dopasowanie entropii tylko dla jednostek logistycznych" # nnet/R/nnet.R: 104 # stop("no weights to fit") msgid "no weights to fit" msgstr "brak wag do dopasowania" # nnet/R/nnet.R: 106 # stop(gettextf("too many (%d) weights", nwts), domain=NA) msgid "too many (%d) weights" msgstr "zbyt dużo (%d) wag" # nnet/R/nnet.R: 113 # stop("'softmax = TRUE' requires at least two response categories") msgid "'softmax = TRUE' requires at least two response categories" msgstr "'softmax = TRUE' wymaga co najmniej dwóch kategorii zmiennej zależnej" # nnet/R/nnet.R: 120 # stop("weights vector of incorrect length") msgid "weights vector of incorrect length" msgstr "wektor wag o niepoprawnej długości" # nnet/R/nnet.R: 121 # stop("incorrect length of 'mask'") msgid "incorrect length of 'mask'" msgstr "niepoprawna długość 'mask'" # nnet/R/nnet.R: 144 # stop("invalid weights vector") # nnet/R/nnet.R: 297 # stop("invalid weights vector") msgid "invalid weights vector" msgstr "niepoprawny wektor wag" # nnet/R/nnet.R: 181 # stop("object not of class \"nnet\"") msgid "object not of class \"nnet\"" msgstr "obiekt nie jest klasy \"nnet\"" # nnet/R/nnet.R: 227 # stop("inappropriate fit for class") msgid "inappropriate fit for class" msgstr "niepoprawne dopasowanie dla klasy" # nnet/R/nnet.R: 280 # stop("dims of 'x' and 'y' must match") msgid "dims of 'x' and 'y' must match" msgstr "wymiary dla 'x' oraz 'y' muszą się zgadzać" # nnet/R/nnet.R: 319 # stop("not a legitimate neural net fit") msgid "not a legitimate neural net fit" msgstr "to nie jest poprawne dopasowanie sieci neuronowych" # nnet/R/multinom.R: 71 # warning(sprintf(ngettext(length(empty), # "group %s is empty", # "groups %s are empty"), # paste(sQuote(empty), collapse=" ")), domain = NA) # nnet/R/nnet.R: 49 # warning(sprintf(ngettext(length(empty), # "group %s is empty", # "groups %s are empty"), # paste(sQuote(empty), collapse=" ")), domain = NA) msgid "group %s is empty" msgid_plural "groups %s are empty" msgstr[0] "grupa %s jest pusta" msgstr[1] "grupy %s są puste" msgstr[2] "grupy %s są puste" nnet/src/0000755000176000001440000000000012164264314012040 5ustar ripleyusersnnet/src/nnet.c0000644000176000001440000004152012164264315013153 0ustar ripleyusers/* nnet/src/nnet.c by W. N. Venables and B. D. Ripley Copyright (C) 1992-2002 * * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 or 3 of the License * (at your option). * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * A copy of the GNU General Public License is available at * http://www.r-project.org/Licenses/ */ /* weights are stored in order of their destination unit. * the array Conn gives the source unit for the weight (0 = bias unit) * the array Nconn gives the number of first weight connecting to each unit, * so the weights connecting to unit i are Nconn[i] ... Nconn[i+1] - 1. * */ #include #include #include typedef double Sdata; static double *vect(int n); static void free_vect(double *v); static double **matrix(int nrh, int nch); static void free_matrix(double **m, int nrh, int nch); static void fpass(Sdata *input, Sdata *goal, Sdata wx, int nr); static void Build_Net(int ninputs, int nhidden, int noutputs); static int Epoch; static double *Decay; static double TotalError; static int Nunits; static int Ninputs; static int FirstHidden; static int FirstOutput; static int Noutputs; static int NSunits; /* number of sigmoid units */ static int Nweights; static int Entropy; static int Linout; static int Softmax; static int Censored; static double *Outputs; static double *ErrorSums; static double *Errors; static int *Nconn; static int *Conn; static double *wts; static double *Slopes; static double *Probs; static int NTrain; static int NTest; static Sdata *TrainIn; static Sdata *TrainOut; static Sdata *Weights; static Sdata *toutputs; void VR_set_net(Sint *n, Sint *nconn, Sint *conn, double *decay, Sint *nsunits, Sint *entropy, Sint *softmax, Sint *censored) { int i; Build_Net((int) n[0], (int) n[1], (int) n[2]); for (i = 0; i <= Nunits; i++) Nconn[i] = nconn[i]; Nweights = Nconn[Nunits]; Conn = Calloc(Nweights, int); wts = Calloc(Nweights, double); Slopes = Calloc(Nweights, double); Probs = Calloc(Nweights, double); Decay = Calloc(Nweights, double); for (i = 0; i < Nweights; i++) Conn[i] = conn[i]; Epoch = 0; for (i = 0; i < Nweights; i++) Decay[i] = decay[i]; TotalError = 0.0; NSunits = *nsunits; Entropy = *entropy; Linout = (NSunits < Nunits); Softmax = *softmax; Censored = *censored; } void VR_unset_net() { Free(Conn); Free(wts); Free(Slopes); Free(Probs); Free(Decay); Free(Nconn); Free(Outputs); Free(ErrorSums); Free(Errors); Free(toutputs); } void VR_nntest(Sint *ntest, Sdata *test, Sdata *result, double *inwts) { int i, j; for (i = 0; i < Nweights; i++) wts[i] = inwts[i]; NTest = *ntest; if (Nweights == 0) error("No model set"); for (i = 0; i < Noutputs; i++) toutputs[i] = 0.5; for (j = 0; j < NTest; j++) { fpass(test + j, toutputs, 1.0, NTest); if (Softmax) for (i = 0; i < Noutputs; i++) result[j + NTest * i] = Probs[FirstOutput + i]; else for (i = 0; i < Noutputs; i++) result[j + NTest * i] = Outputs[FirstOutput + i]; } } static void Build_Net(int ninputs, int nhidden, int noutputs) { Nunits = 1 + ninputs + nhidden + noutputs; Nconn = Calloc(Nunits + 1, int); Outputs = Calloc(Nunits, double); ErrorSums = Calloc(Nunits, double); Errors = Calloc(Nunits, double); toutputs = Calloc(Nunits, Sdata); Ninputs = ninputs; FirstHidden = 1 + ninputs; FirstOutput = 1 + ninputs + nhidden; Noutputs = noutputs; Outputs[0] = 1.0; } static double sigmoid(double sum) { if (sum < -15.0) return (0.0); else if (sum > 15.0) return (1.0); else return (1.0 / (1.0 + exp(-sum))); } #define EPS 1.0E-80 static double E(double y, double t) { double dif, sum = 0; if (Entropy) { if (t > 0) sum -= t * log((y + EPS) / t); if (t < 1) sum -= (1 - t) * log((1 - y + EPS) / (1 - t)); } else { dif = y - t; sum = dif * dif; } return (sum); } static void fpass(Sdata *input, Sdata *goal, Sdata wx, int nr) { int i, j; double sum, t, thisError; for (i = 0; i < Ninputs; i++) Outputs[i + 1] = input[i * nr]; for (j = FirstHidden; j < Nunits; j++) { sum = 0.0; for (i = Nconn[j]; i < Nconn[j + 1]; i++) sum += Outputs[Conn[i]] * wts[i]; if (j < NSunits) sum = sigmoid(sum); Outputs[j] = sum; } if (Softmax) { sum = 0.0; /* avoid overflows by re-normalizing */ t = Outputs[FirstOutput]; for (i = FirstOutput + 1; i < Nunits; i++) if (Outputs[i] > t) t = Outputs[i]; for (i = FirstOutput; i < Nunits; i++) { Probs[i] = exp(Outputs[i] - t); sum += Probs[i]; } thisError = 0.0; for (i = FirstOutput; i < Nunits; i++) { Probs[i] = Probs[i] / sum; t = goal[i - FirstOutput]; if (Censored) { if (t == 1) thisError += Probs[i]; } else if (t > 0) { if (Probs[i] > 0) TotalError -= wx * t * log(Probs[i]); else TotalError += wx * 1000; } } if (Censored) { if (thisError > 0) TotalError -= wx * log(thisError); else TotalError += wx * 1000; } } else for (i = FirstOutput; i < Nunits; i++) TotalError += wx * E(Outputs[i], goal[i - FirstOutput]); } static double sigmoid_prime(double value) { return (value * (1.0 - value)); } static double sigmoid_prime_prime(double value) { return (value * (1.0 - value) * (1.0 - 2.0 * value)); } static void bpass(Sdata *goal, Sdata wx) { int i, j, cix; double sum, denom; if (Softmax) { if (Censored) { denom = 0.0; for (i = FirstOutput; i < Nunits; i++) if (goal[i - FirstOutput] == 1) denom += Probs[i]; for (i = FirstOutput; i < Nunits; i++) { ErrorSums[i] = Probs[i]; if (goal[i - FirstOutput] == 1) ErrorSums[i] -= Probs[i] / denom; } } else { sum = 0.0; for (i = FirstOutput; i < Nunits; i++) sum += goal[i - FirstOutput]; for (i = FirstOutput; i < Nunits; i++) ErrorSums[i] = sum * Probs[i] - goal[i - FirstOutput]; } } else if (Entropy) for (i = FirstOutput; i < Nunits; i++) ErrorSums[i] = Outputs[i] - goal[i - FirstOutput]; else for (i = FirstOutput; i < Nunits; i++) { ErrorSums[i] = 2 * (Outputs[i] - goal[i - FirstOutput]); if (i < NSunits) ErrorSums[i] *= sigmoid_prime(Outputs[i]); } for (i = FirstHidden; i < FirstOutput; i++) ErrorSums[i] = 0.0; for (j = Nunits - 1; j >= FirstHidden; j--) { Errors[j] = ErrorSums[j]; if (j < FirstOutput) Errors[j] *= sigmoid_prime(Outputs[j]); for (i = Nconn[j]; i < Nconn[j + 1]; i++) { cix = Conn[i]; ErrorSums[cix] += Errors[j] * wts[i]; Slopes[i] += wx * Errors[j] * Outputs[cix]; } } } void VR_dfunc(double *p, double *df, double *fp) { int i, j; double sum1; for (i = 0; i < Nweights; i++) wts[i] = p[i]; for (j = 0; j < Nweights; j++) Slopes[j] = 2 * Decay[j] * wts[j]; TotalError = 0.0; for (i = 0; i < NTrain; i++) { for (j = 0; j < Noutputs; j++) toutputs[j] = TrainOut[i + NTrain * j]; fpass(TrainIn + i, toutputs, Weights[i], NTrain); bpass(toutputs, Weights[i]); } sum1 = 0.0; for (i = 0; i < Nweights; i++) sum1 += Decay[i] * p[i] * p[i]; *fp = TotalError + sum1; for (j = 0; j < Nweights; j++) df[j] = Slopes[j]; Epoch++; } static double fminfn(int nn, double *p, void *dummy) { int i, j; double sum1; for (i = 0; i < Nweights; i++) wts[i] = p[i]; TotalError = 0.0; for (i = 0; i < NTrain; i++) { for (j = 0; j < Noutputs; j++) toutputs[j] = TrainOut[i + NTrain * j]; fpass(TrainIn + i, toutputs, Weights[i], NTrain); } sum1 = 0.0; for (i = 0; i < Nweights; i++) sum1 += Decay[i] * p[i] * p[i]; Epoch++; return (TotalError + sum1); } static void fmingr(int nn, double *p, double *df, void *dummy) { int i, j; for (i = 0; i < Nweights; i++) wts[i] = p[i]; for (j = 0; j < Nweights; j++) Slopes[j] = 2 * Decay[j] * wts[j]; TotalError = 0.0; for (i = 0; i < NTrain; i++) { for (j = 0; j < Noutputs; j++) toutputs[j] = TrainOut[i + NTrain * j]; fpass(TrainIn + i, toutputs, Weights[i], NTrain); bpass(toutputs, Weights[i]); } for (j = 0; j < Nweights; j++) df[j] = Slopes[j]; Epoch++; } static double * vect(int n) { double *v; v = Calloc(n, double); return v; } static void free_vect(double *v) { Free(v); } static double ** matrix(int nrh, int nch) { int i; double **m; m = Calloc((nrh + 1), double *); for (i = 0; i <= nrh; i++) { m[i] = Calloc((nch + 1), double); } return m; } static void free_matrix(double **m, int nrh, int nch) { int i; for (i = nrh; i >= 0; i--) Free(m[i]); Free(m); } static double ** Lmatrix(int n) { int i; double **m; m = Calloc(n, double *); for (i = 0; i < n; i++) { m[i] = Calloc((i + 1), double); } return m; } static void free_Lmatrix(double **m, int n) { int i; for (i = n - 1; i >= 0; i--) Free(m[i]); Free(m); } #define REPORT 10 void VR_dovm(Sint *ntr, Sdata *train, Sdata *weights, Sint *Nw, double *wts, double *Fmin, Sint *maxit, Sint *trace, Sint *mask, double *abstol, double *reltol, int *ifail) { int fncount, grcount; NTrain = *ntr; TrainIn = train; TrainOut = train + Ninputs * NTrain; Weights = weights; vmmin((int) *Nw, wts, Fmin, fminfn, fmingr, (int) *maxit, (int) *trace, mask, *abstol, *reltol, REPORT, NULL, &fncount, &grcount, ifail); } static double **H, *h, *h1, **w; static void pHessian(Sdata *input, Sdata *goal, Sdata wx, int nr) { int i, to1, to2, from1, from2, j, j1, j2, first1, first2; double out, s, sum1, sum2, t, tmp, tot = 0.0, P = 0.0; fpass(input, goal, 1.0, nr); bpass(goal, 1.0); /* Formulae from Ripley (1996, p.152) */ if (Softmax) { for (i = 0; i < Nunits; i++) { sum1 = 0.0; sum2 = 0.0; tot = 0.0; P = 0.0; for (j = FirstOutput; j < Nunits; j++) { sum1 += w[i][j] * Probs[j]; t = goal[j - FirstOutput]; P += t * Probs[j]; sum2 += w[i][j] * Probs[j] * t; tot += t; } h[i] = sum1; h1[i] = sum2 / P; } if(Censored) tot = 1; for (to1 = 0; to1 < Nunits; to1++) for (j1 = Nconn[to1]; j1 < Nconn[to1 + 1]; j1++) { from1 = Conn[j1]; first1 = (to1 < FirstOutput); for (to2 = 0; to2 < Nunits; to2++) for (j2 = Nconn[to2]; j2 < Nconn[to2 + 1]; j2++) if (j2 <= j1) { from2 = Conn[j2]; first2 = (to2 < FirstOutput); if ((!first1) && (!first2)) { /* both -> output */ if (Censored) { tmp = -Probs[to1] * Probs[to2] * (1 - goal[to1 - FirstOutput] * goal[to2 - FirstOutput] / P / P); if (to1 == to2) tmp += Probs[to1] * (1 - goal[to1 - FirstOutput] / P); H[j1][j2] += wx * (tmp * Outputs[from1] * Outputs[from2]); } else { tmp = -Probs[to1] * Probs[to2]; if (to1 == to2) tmp += Probs[to1]; H[j1][j2] += wx * tot * (tmp * Outputs[from1] * Outputs[from2]); } } else if (first1 && first2) { /* both -> hidden */ sum1 = sum2 = 0.0; for (i = FirstOutput; i < Nunits; i++) { sum1 += Errors[i] * w[to1][i]; tmp = w[to1][i] * w[to2][i] * Probs[i]; if (Censored) tmp *= (1 - goal[i - FirstOutput] / P); sum2 += tmp; } if (Censored) { sum2 += -h[to1] * h[to2] + h1[to1] * h1[to2]; s = sigmoid_prime(Outputs[to1]) * sigmoid_prime(Outputs[to2]) * sum2; } else { sum2 -= h[to1] * h[to2]; s = sigmoid_prime(Outputs[to1]) * sigmoid_prime(Outputs[to2]) * tot * sum2; } if (to1 == to2) s += sigmoid_prime_prime(Outputs[to1]) * sum1; H[j1][j2] += wx * (s * Outputs[from1] * Outputs[from2]); } else { /* one -> hidden, one -> output */ if (to1 < to2) { tmp = w[to1][to2] - h[to1]; if (Censored) tmp += goal[to2 - FirstOutput] / P * (h1[to1] - w[to1][to2]); H[j1][j2] += wx * (Outputs[from1] * sigmoid_prime(Outputs[to1]) * (Outputs[from2] * Probs[to2] * tmp * tot + ((to1 == from2) ? Errors[to2] : 0))); } else { tmp = w[to2][to1] - h[to2]; if (Censored) tmp += goal[to1 - FirstOutput] / P * (h1[to2] - w[to2][to1]); H[j1][j2] += wx * (Outputs[from2] * sigmoid_prime(Outputs[to2]) * (Outputs[from1] * Probs[to1] * tmp * tot + ((to2 == from1) ? Errors[to1] : 0))); } } } } } else { /* Not softmax */ for (i = FirstOutput; i < Nunits; i++) { out = Outputs[i]; s = sigmoid_prime(out); t = goal[i - FirstOutput]; if (Linout) h[i] = 2; else if (Entropy) h[i] = out * (1 - out); else h[i] = sigmoid_prime_prime(out) * 2 * (out - t) + 2 * s * s; } for (to1 = 0; to1 < Nunits; to1++) for (j1 = Nconn[to1]; j1 < Nconn[to1 + 1]; j1++) { from1 = Conn[j1]; first1 = (to1 < FirstOutput); for (to2 = 0; to2 < Nunits; to2++) for (j2 = Nconn[to2]; j2 < Nconn[to2 + 1]; j2++) if (j2 <= j1) { from2 = Conn[j2]; first2 = (to2 < FirstOutput); if ((!first1) && (!first2)) { /* both -> output */ if (to1 == to2) H[j1][j2] += wx * (h[to1] * Outputs[from1] * Outputs[from2]); } else if (first1 && first2) { /* both -> hidden */ sum1 = sum2 = 0.0; for (i = FirstOutput; i < Nunits; i++) { sum1 += Errors[i] * w[to1][i]; sum2 += w[to1][i] * w[to2][i] * h[i]; } s = sigmoid_prime(Outputs[to1]) * sigmoid_prime(Outputs[to2]) * sum2; if (to1 == to2) s += sigmoid_prime_prime(Outputs[to1]) * sum1; H[j1][j2] += wx * (s * Outputs[from1] * Outputs[from2]); } else { /* one -> hidden, one -> output */ if (to1 < to2) { H[j1][j2] += wx * (Outputs[from1] * sigmoid_prime(Outputs[to1]) * (Outputs[from2] * w[to1][to2] * h[to2] + ((to1 == from2) ? Errors[to2] : 0))); } else { H[j1][j2] += wx * (Outputs[from2] * sigmoid_prime(Outputs[to2]) * (Outputs[from1] * w[to2][to1] * h[to1] + ((to2 == from1) ? Errors[to1] : 0))); } } } } } } #define max9(a,b) a>b?a:b #define min9(a,b) a b[i]) - 1); return (0); } /* Z is transposed, so (p+q) x n */ void VR_summ2(Sint *n0, Sint *p0, Sint *q0, Sdata *Z, Sint *na) { int n = *n0, m; int i, j, k, l; p = *p0; q = *q0; m = p + q; qsort(Z, n, m * sizeof(Sdata), (int (*)(const void *, const void *)) Zcompar); j = 0; for (i = 1; i < n; i++) { k = -1; for (l = 0; l < p; l++) if (Z[l + i * m] != Z[l + (i - 1) * m]) { k = l; break; } if (k >= 0) { j++; for (l = 0; l < m; l++) Z[l + j * m] = Z[l + i * m]; } else for (l = p; l < m; l++) Z[l + j * m] += Z[l + i * m]; } *na = j + 1; } #include "R_ext/Rdynload.h" static const R_CMethodDef CEntries[] = { {"VR_dfunc", (DL_FUNC) &VR_dfunc, 3}, {"VR_dovm", (DL_FUNC) &VR_dovm, 12}, {"VR_nnHessian", (DL_FUNC) &VR_nnHessian, 5}, {"VR_nntest", (DL_FUNC) &VR_nntest, 4}, {"VR_set_net", (DL_FUNC) &VR_set_net, 8}, {"VR_summ2", (DL_FUNC) &VR_summ2, 5}, {"VR_unset_net", (DL_FUNC) &VR_unset_net, 0}, {NULL, NULL, 0} }; #include void R_init_nnet(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); #if defined(R_VERSION) && R_VERSION >= R_Version(2, 16, 0) R_forceSymbols(dll, TRUE); #endif } nnet/MD50000644000176000001440000000246312164265440011567 0ustar ripleyusersa3f7d4d6ab825f06d20bc3a180a33016 *DESCRIPTION a14861d4c76b0028b6dc635163b00297 *LICENCE.note 6b63278a92236d85fbc16016a817d781 *NAMESPACE 55060d17d95acf2b20f15c91c86f4715 *R/multinom.R 41a395f39ad495ba3b1a9200dc21e505 *R/nnet.R ffabc72d117270490cfe8495be8e7b9e *R/vcovmultinom.R 91cbc73bd6fed6d715f20cd97e7a47ac *R/zzz.R aea650cb108dfd007ba5b35ad6ff7226 *inst/CITATION 4729791c0e3f51b8bfe12b92b1ecfaf2 *inst/NEWS 4682a1b1ed1e5484274b4ff1337e4afd *inst/po/de/LC_MESSAGES/R-nnet.mo ecdf8191d74a562ce01e2089f7feb15f *inst/po/en@quot/LC_MESSAGES/R-nnet.mo d98b4282978de19abb84d70b0c3d096d *inst/po/fr/LC_MESSAGES/R-nnet.mo 4832320a4f61d7f3e7f24860f417b052 *inst/po/ko/LC_MESSAGES/R-nnet.mo 9fb2724cfac89e2982cdc6278af4acf7 *inst/po/pl/LC_MESSAGES/R-nnet.mo 658e8411d785b785db614690f26710b0 *man/class.ind.Rd 874db37ca4219d26c6a908f1c604016d *man/multinom.Rd cd6a3761edca3e8aa4c84b873f48f9ff *man/nnet.Hess.Rd 5549369cf450981481c450ff31720fe7 *man/nnet.Rd a3b762d16d720130f354292ec6e5d3ad *man/predict.nnet.Rd c7c8e6b1a1aee45883904ef3309dc852 *man/which.is.max.Rd 4cc26e5da1e3bac49338eeef537a782e *po/R-de.po 2f4ec60d8d5171edfa72b0ef67eebaba *po/R-fr.po de51a54fe6779cc2e43c3ab66d480276 *po/R-ko.po d5d91a6e9e993aa253c1081c8eb2672e *po/R-nnet.pot d9061092c5c1787140e2cda4a5f53ae2 *po/R-pl.po 7df5fbf009180cb7a0865dce4d0b7447 *src/nnet.c