[R] Source code for ppr (Projection Pursuit Regression)

[Erin Hodgess]

To get the references, check ?ppr

For the code:

> methods(ppr)
[1] ppr.default* ppr.formula*

   Non-visible functions are asterisked
> getAnywhere(ppr.default)
A single object matching 'ppr.default' was found
It was found in the following places
  registered S3 method for ppr from namespace stats
  namespace:stats
with value

function (x, y, weights = rep(1, n), ww = rep(1, q), nterms,
    max.terms = nterms, optlevel = 2, sm.method = c("supsmu",
        "spline", "gcvspline"), bass = 0, span = 0, df = 5, gcvpen = 1,
    ...)
{
    call <- match.call()
    call[[1]] <- as.name("ppr")
    sm.method <- match.arg(sm.method)
    ism <- switch(sm.method, supsmu = 0, spline = 1, gcvspline = 2)
    if (missing(nterms))
        stop("'nterms' is missing with no default")
    mu <- nterms
    ml <- max.terms
    x <- as.matrix(x)
    y <- as.matrix(y)
    if (!is.numeric(x) || !is.numeric(y))
        stop("'ppr' applies only to numerical variables")
    n <- nrow(x)
    if (nrow(y) != n)
        stop("mismatched 'x' and 'y'")
    p <- ncol(x)
    q <- ncol(y)
    if (!is.null(dimnames(x)))
        xnames <- dimnames(x)[[2]]
    else xnames <- paste("X", 1:p, sep = "")
    if (!is.null(dimnames(y)))
        ynames <- dimnames(y)[[2]]
    else ynames <- paste("Y", 1:q, sep = "")
    msmod <- ml * (p + q + 2 * n) + q + 7 + ml + 1
    nsp <- n * (q + 15) + q + 3 * p
    ndp <- p * (p + 1)/2 + 6 * p
    .Fortran(R_setppr, as.double(span), as.double(bass), as.integer(optlevel),
        as.integer(ism), as.double(df), as.double(gcvpen))
    Z <- .Fortran(R_smart, as.integer(ml), as.integer(mu), as.integer(p),
        as.integer(q), as.integer(n), as.double(weights), as.double(t(x)),
        as.double(t(y)), as.double(ww), smod = double(msmod),
        as.integer(msmod), double(nsp), as.integer(nsp), double(ndp),
        as.integer(ndp), edf = double(ml))
    smod <- Z$smod
    ys <- smod[q + 6]
    tnames <- paste("term", 1:mu)
    alpha <- matrix(smod[q + 6 + 1:(p * mu)], p, mu, dimnames = list(xnames,
        tnames))
    beta <- matrix(smod[q + 6 + p * ml + 1:(q * mu)], q, mu,
        dimnames = list(ynames, tnames))
    fitted <- drop(matrix(.Fortran(R_pppred, as.integer(nrow(x)),
        as.double(x), as.double(smod), y = double(nrow(x) * q),
        double(2 * smod[4]))$y, ncol = q, dimnames = dimnames(y)))
    jt <- q + 7 + ml * (p + q + 2 * n)
    gof <- smod[jt] * n * ys^2
    gofn <- smod[jt + 1:ml] * n * ys^2
    jf <- q + 6 + ml * (p + q)
    smod <- smod[c(1:(q + 6 + p * mu), q + 6 + p * ml + 1:(q *
        mu), jf + 1:(mu * n), jf + ml * n + 1:(mu * n))]
    smod[1] <- mu
    structure(list(call = call, mu = mu, ml = ml, p = p, q = q,
        gof = gof, gofn = gofn, df = df, edf = Z$edf[1:mu], xnames = xnames,
        ynames = ynames, alpha = drop(alpha), beta = ys * drop(beta),
        yb = smod[5 + 1:q], ys = ys, fitted.values = fitted,
        residuals = drop(y - fitted), smod = smod), class = "ppr")
}
<environment: namespace:stats>
>

Hope this helps!

Sincerely,
Erin


On Tue, Oct 28, 2008 at 10:53 AM, Arvind Iyer <arvind.v.iyer at gmail.com> wrote:
> Dear R users,
>
> I am looking for the source code of the implementation of ppr (Projection
> Pursuit Regression) in R.
>
> It will be great if citations of the source papers on which the
> implementation is based, are also provided.
>
> Thank you,
> Arvind Iyer,
> Grad student, Deptt. of Biomedical Engineering
> Viterbi School of Engineering
> University of Southern California, Los Angeles
>
>        [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>



-- 
Erin Hodgess
Associate Professor
Department of Computer and Mathematical Sciences
University of Houston - Downtown
mailto: erinm.hodgess at gmail.com