https://github.com/cran/ftsa
Raw File
Tip revision: 2be2cac4679ad78e8ae44283f0200a83b4a2dab9 authored by Han Lin Shang on 09 November 2010, 10:17:30 UTC
version 2.1
Tip revision: 2be2cac
rapca.r
rapca = function (x, FUN = Qn, order = 4, mean = TRUE)
{
    if (order < 1)
        stop("Order must be positive")
    X <- t(x)
    n <- nrow(X)
    p <- ncol(X)
    if (mean) {
        med <- colMeans(X)
        xx <- sweep(X, 2, med)
    }
    else xx <- X
    tmp <- La.svd(xx)
    r = sum(tmp$d > (max(n, p) * max(tmp$d) * 1e-12))
    P <- t(tmp$vt)[, 1:r]
    tmp2 <- rstep(t(xx %*% P), order = order, r = tmp$r, mean = mean)
    tmp <- P %*% tmp2$basis
    if (mean) {
        med <- c(med + tmp[, 1])
        xx <- sweep(X, 2, med)
        basis <- cbind(med, tmp[, (1:order) + 1])
        coef <- cbind(rep(1, n), xx %*% basis[, -1])
    }
    else {
        basis <- tmp
        coef <- xx %*% basis
    }
    return(list(basis = basis, coeff = coef, X = xx))
}
back to top