1 | marpca.sub(x, p = ncol(x) - 1, N1 = 3, N2 = 2, tol = 0.001, B = NULL, a = NULL, LSCALE = TRUE)
|
x |
|
p |
|
N1 |
|
N2 |
|
tol |
|
B |
|
a |
|
LSCALE |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | ##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function (x, p = ncol(x) - 1, N1 = 3, N2 = 2, tol = 0.001, B = NULL,
a = NULL, LSCALE = TRUE)
{
wt.cov <- NULL
if (!is.null(B)) {
B <- as.matrix(B)
if (ncol(B) == 1)
B <- t(B)
}
n <- nrow(x)
m <- ncol(x)
q <- m - p
if (q < 0)
stop("p and q should have values between 1 and ncol(x)")
hval <- floor((n + m - q + 2)/2)
DEL <- Inf
sig0 <- Inf
if (is.null(B)) {
if (p > 0 && p < m) {
B <- matrix(runif(q * m), nrow = q, ncol = m)
B <- t(ortho(t(B)))
}
if (p == 0)
B <- diag(rep(1, m))
}
it <- 1
Bx <- matrix(NA, ncol = q, nrow = n)
for (i in 1:n) Bx[i, ] <- B %*% as.matrix(x[i, ])
if (is.null(a))
a <- apply(Bx, 2, FUN = "median")
while (it < N1 + N2 && DEL > tol) {
r <- NA
for (i in 1:n) r[i] <- sum(Bx[i, ] - a)^2
if (LSCALE)
sig <- lscale(r, m, q)
if (!LSCALE) {
delta <- delta <- (n - m + q - 1)/(2 * n)
sig <- mscale(r, delta)
}
DEL <- 1 - sig/sig0
sig0 <- sig
ord.r <- order(r)
w <- rep(0, n)
w[ord.r[1:hval]] <- 1
xx <- x
for (i in 1:n) xx[i, ] <- x[i, ] * w[i]
mu <- apply(xx, 2, FUN = "sum")/sum(w)
Cmat <- matrix(0, nrow = m, ncol = m)
for (i in 1:n) {
temp <- w[i] * as.matrix(x[i, ] - mu) %*% t(as.matrix(x[i,
] - mu))
Cmat <- Cmat + temp
}
wt.cov <- Cmat/sum(w)
if (it > N1) {
temp <- eigen(wt.cov)
ord.eig <- order(temp$values)
for (iq in 1:q) B[iq, ] <- temp$vectors[, ord.eig[iq]]
}
a <- B %*% mu
it <- it + 1
}
list(B = B, a = a, var.op = sig, mu = mu, wt.cov = wt.cov)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.