rtdep:

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

Usage

rtdep(pts, m, nsamp = 100, SEED = NA)

Arguments

pts
m
nsamp
SEED

Examples

##---- 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 (pts, m, nsamp = 100, SEED = NA) 
{
    set.seed(2)
    if (!is.na(SEED)) 
        set.seed(SEED)
    if (!is.matrix(m)) 
        stop("Second argument is not a matrix")
    if (ncol(m) == 2) 
        tdep <- depth(pts[1], pts[2], m)
    if (ncol(m) > 2) {
        n <- nrow(m)
        pts <- matrix(pts, ncol = ncol(m))
        mold <- m
        p <- ncol(m)
        pm1 <- p - 1
        mdup <- matrix(rep(pts, nrow(m)), ncol = ncol(m), byrow = T)
        dif <- abs(m - mdup)
        chk <- apply(dif, 1, sum)
        flag <- (chk != 0)
        m <- m[flag, ]
        m <- as.matrix(m)
        dmin <- sum(chk == 0)
        m3 <- rbind(m, pts)
        tdep <- nrow(m) + 1
        for (i in 1:nsamp) {
            mat <- sample(nrow(m), pm1, T)
            if (p > 2) 
                x <- rbind(m[mat, 2:p], pts[, 2:p])
            y <- c(m[mat, 1], pts[1])
            if (prod(eigen(var(x))$values) > 10^{
                -8
            }) {
                temp <- qr(x)
                if (temp$rank[1] == ncol(x)) {
                  temp <- lsfit(x, y)$coef
                  m2 <- cbind(rep(1, nrow(m3)), m3[, 2:p])
                  res <- m3[, 1] - temp %*% t(m2)
                  p1 <- sum((res > 0))
                  p2 <- sum((res < 0))
                  tdep <- min(c(tdep, p1, p2))
                  if (tdep < dmin) 
                    tdep <- dmin
                }
            }
        }
        tdep <- tdep/n
    }
    tdep
  }

musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.