outproMC:
In musto101/wilcox_R: What the package does (short line)

Usage Arguments Examples

1	outproMC(m, gval = NA, center = NA, plotit = TRUE, op = T, MM = F, cop = 3, xlab = "VAR 1", ylab = "VAR 2", STAND = TRUE, tr = 0.2, q = 0.5, pr = TRUE, ...)

`m`
`gval`
`center`
`plotit`
`op`
`MM`
`cop`
`xlab`
`ylab`
`STAND`
`tr`
`q`
`pr`
`...`

##---- 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, gval = NA, center = NA, plotit = TRUE, op = T, MM = F, 
    cop = 3, xlab = "VAR 1", ylab = "VAR 2", STAND = TRUE, tr = 0.2, 
    q = 0.5, pr = TRUE, ...) 
{
    library(parallel)
    library(MASS)
    m <- as.matrix(m)
    if (pr) {
        if (!STAND) {
            if (ncol(m) > 1) 
                print("STAND=FALSE. If measures are on different scales, might want to use STAND=TRUE")
        }
    }
    if (ncol(m) == 1) {
        dis <- (m - median(m))^2/mad(m)^2
        dis <- sqrt(dis)
        crit <- sqrt(qchisq(0.975, 1))
        chk <- ifelse(dis > crit, 1, 0)
        vec <- c(1:nrow(m))
        outid <- vec[chk == 1]
        keep <- vec[chk == 0]
    }
    if (ncol(m) > 1) {
        if (STAND) 
            m = standm(m, est = median, scat = mad)
        if (is.na(gval) && cop == 1) 
            gval <- sqrt(qchisq(0.95, ncol(m)))
        if (is.na(gval) && cop != 1) 
            gval <- sqrt(qchisq(0.975, ncol(m)))
        m <- elimna(m)
        if (cop == 1 && is.na(center[1])) {
            if (ncol(m) > 2) 
                center <- dmean(m, tr = 0.5, cop = 1)
            if (ncol(m) == 2) {
                tempd <- NA
                for (i in 1:nrow(m)) tempd[i] <- depth(m[i, 1], 
                  m[i, 2], m)
                mdep <- max(tempd)
                flag <- (tempd == mdep)
                if (sum(flag) == 1) 
                  center <- m[flag, ]
                if (sum(flag) > 1) 
                  center <- apply(m[flag, ], 2, mean)
            }
        }
        if (cop == 2 && is.na(center[1])) {
            center <- cov.mcd(m)$center
        }
        if (cop == 4 && is.na(center[1])) {
            center <- cov.mve(m)$center
        }
        if (cop == 3 && is.na(center[1])) {
            center <- apply(m, 2, median)
        }
        if (cop == 5 && is.na(center[1])) {
            center <- tbs(m)$center
        }
        if (cop == 6 && is.na(center[1])) {
            center <- rmba(m)$center
        }
        if (cop == 7 && is.na(center[1])) {
            center <- spat(m)
        }
        flag <- rep(0, nrow(m))
        outid <- NA
        vec <- c(1:nrow(m))
        cenmat = matrix(rep(center, nrow(m)), ncol = ncol(m), 
            byrow = T)
        Amat = m - cenmat
        B = listm(t(Amat))
        dis = mclapply(B, outproMC.sub, Amat)
        flag = mclapply(dis, outproMC.sub2, MM, gval)
        flag = matl(flag)
        flag = apply(flag, 1, max)
    }
    if (sum(flag) == 0) 
        outid <- NA
    if (sum(flag) > 0) 
        flag <- (flag == 1)
    outid <- vec[flag]
    idv <- c(1:nrow(m))
    keep <- idv[!flag]
    if (ncol(m) == 2) {
        if (plotit) {
            plot(m[, 1], m[, 2], type = "n", xlab = xlab, ylab = ylab)
            points(m[keep, 1], m[keep, 2], pch = "*")
            if (length(outid) > 0) 
                points(m[outid, 1], m[outid, 2], pch = "o")
            if (op) {
                tempd <- NA
                keep <- keep[!is.na(keep)]
                mm <- m[keep, ]
                for (i in 1:nrow(mm)) tempd[i] <- depth(mm[i, 
                  1], mm[i, 2], mm)
                mdep <- max(tempd)
                flag <- (tempd == mdep)
                if (sum(flag) == 1) 
                  center <- mm[flag, ]
                if (sum(flag) > 1) 
                  center <- apply(mm[flag, ], 2, mean)
                m <- mm
            }
            points(center[1], center[2], pch = "+")
            x <- m
            temp <- fdepth(m, plotit = FALSE)
            flag <- (temp >= median(temp))
            xx <- x[flag, ]
            xord <- order(xx[, 1])
            xx <- xx[xord, ]
            temp <- chull(xx)
            xord <- order(xx[, 1])
            xx <- xx[xord, ]
            temp <- chull(xx)
            lines(xx[temp, ])
            lines(xx[c(temp[1], temp[length(temp)]), ])
        }
    }
    list(out.id = outid, keep = keep)
  }