| 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.