1 |
m |
|
corfun |
|
cop |
|
MM |
|
gval |
|
ap |
|
pw |
|
STAND |
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 | ##---- 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 (m, corfun = spear, cop = 3, MM = FALSE, gval = NA,
ap = TRUE, pw = TRUE, STAND = TRUE)
{
m <- elimna(m)
p <- ncol(m)
pm <- p - 1
n <- nrow(m)
if (p < 2)
stop("Something wrong; number of variables is < 2")
if (pw && cop == 1) {
print("If execution time is too high,")
print("use cop=2 or 4 rather than the default value of 1")
}
if (ap) {
inter <- c(2.374, 2.78, 3.03, 3.208, 3.372, 3.502, 3.722,
3.825, 3.943)
slope <- c(5.333, 8.8, 25.67, 32.83, 51.53, 75.02, 111.34,
123.16, 126.72)
expo <- c(-1, -1, -1.2, -1.2, -1.3, -1.4, -1.5, -1.5,
-1.5)
if (p > 10) {
qvec <- NA
for (i in 1:9) qvec[i] <- inter[i] + slope[i] * n^expo[i]
pval <- c(2:10)
temp <- lsfit(pval, qvec)$coef
}
}
if (!ap) {
inter <- c(2.374, 2.54, 2.666, 2.92, 2.999, 3.097, 3.414,
3.286, 3.258)
slope <- c(5.333, 8.811, 14.89, 20.59, 51.01, 52.15,
58.498, 64.934, 59.127)
expo <- c(-1, -1, -1.2, -1.2, -1.5, -1.5, -1.5, -1.5,
-1.5)
if (p > 10) {
qvec <- NA
for (i in 1:9) qvec[i] <- inter[i] + slope[i] * n^expo[i]
pval <- c(1:9)
temp <- lsfit(pval, qvec)$coef
}
}
if (p <= 10)
crit <- inter[pm] + slope[pm] * n^expo[pm]
if (p > 10)
crit <- temp[2] * p + temp[1]
if (cop != 1 && is.na(gval))
gval <- sqrt(qchisq(0.975, ncol(m)))
temp <- outpro(m, plotit = FALSE, MM = MM, gval = gval, cop = cop,
STAND = STAND)$keep
mcor <- corfun(m[temp, ])$cor
test <- abs(mcor * sqrt((nrow(m) - 2)/(1 - mcor^2)))
diag(test) <- NA
if (!ap) {
test <- as.matrix(test[1, ])
}
list(cor = mcor, crit.val = crit, test.stat = test)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.