fdepthv2:

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

Usage

fdepthv2(m, pts = NA, plotit = TRUE)

Arguments

m
pts
plotit

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 (m, pts = NA, plotit = TRUE) 
{
    m <- elimna(m)
    if (!is.na(pts[1])) 
        remm <- m
    if (!is.matrix(m)) 
        dep <- unidepth(m)
    if (is.matrix(m)) {
        nm <- nrow(m)
        nt <- nm
        nm1 <- nm + 1
        if (!is.na(pts[1])) {
            if (ncol(m) != ncol(pts)) 
                stop("Number of columns of m is not equal to number of columns for pts")
            nt <- nm + nrow(pts)
        }
    }
    if (ncol(m) == 1) 
        depth <- unidepth(m)
    if (ncol(m) > 1) {
        m <- elimna(m)
        nc <- (nrow(m)^2 - nrow(m))/2
        if (is.na(pts[1])) 
            mdep <- matrix(0, nrow = nc, ncol = nrow(m))
        if (!is.na(pts[1])) {
            mdep <- matrix(0, nrow = nc, ncol = nrow(pts))
        }
        ic <- 0
        for (iall in 1:nm) {
            for (i in 1:nm) {
                if (iall < i) {
                  ic <- ic + 1
                  B <- m[i, ] - m[iall, ]
                  dis <- NA
                  BB <- B^2
                  bot <- sum(BB)
                  if (bot != 0) {
                    if (is.na(pts[1])) {
                      for (j in 1:nrow(m)) {
                        A <- m[j, ] - m[iall, ]
                        temp <- sum(A * B) * B/bot
                        dis[j] <- sign(sum(A * B)) * sqrt(sum(temp^2))
                      }
                    }
                    if (!is.na(pts[1])) {
                      m <- rbind(remm, pts)
                      for (j in 1:nrow(m)) {
                        A <- m[j, ] - m[iall, ]
                        temp <- sum(A * B) * B/bot
                        dis[j] <- sign(sum(A * B)) * sqrt(sum(temp^2))
                      }
                    }
                    if (is.na(pts[1])) 
                      mdep[ic, ] <- unidepth(dis)
                    if (!is.na(pts[1])) {
                      mdep[ic, ] <- unidepth(dis[1:nm], dis[nm1:nrow(m)])
                    }
                  }
                  if (bot == 0) 
                    mdep[ic, ] <- rep(0, ncol(mdep))
                }
            }
        }
        dep <- apply(mdep, 2, min)
    }
    if (ncol(m) == 2 && is.na(pts[1])) {
        flag <- chull(m)
        dep[flag] <- min(dep)
    }
    if (ncol(m) == 2) {
        if (is.na(pts[1]) && plotit) {
            plot(m)
            x <- m
            temp <- dep
            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)]), ])
        }
    }
    dep
  }

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