sir:

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

Usage

sir(x, y, h)

Arguments

x
y
h

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 (x, y, h) 
{
    n <- nrow(x)
    ndim <- ncol(x)
    if (n != length(c(y))) {
        stop("length of y doesn't match to number of rows of x !!")
    }
    if (-h > n) {
        stop("Number of elements within slices can't exceed number of data !!")
    }
    xb <- apply(x, 2, mean)
    si2 <- solve(chol(var(x)))
    xt <- (x - matrix(xb, nrow(x), ncol(x), byrow = T)) %*% si2
    ord1 <- order(y)
    data <- cbind(y[ord1], xt[ord1, ])
    if (h <= -2) {
        h <- abs(h)
        ns <- floor(n/h)
        condit <- 1:n
        choice <- (1:ns) * h
        if (h * ns != n) {
            hk <- floor((n - h * ns)/2)
            choice <- choice + hk
            choice[ns] <- n
        }
    }
    else if (h >= 2) {
        ns <- h
        slwidth <- (data[n, 1] - data[1, 1])/ns
        slend <- seq(data[1, 1] + slwidth, length = ns, by = slwidth)
        slend[ns] <- data[n, 1]
        condit <- c(data[, 1])
        choice <- slend
    }
    else if ((0 < h) && (h < 1)) {
        ns <- floor(1/h)
        slwidth <- (data[n, 1] - data[1, 1]) * h
        slend <- seq(data[1, 1] + slwidth, length = ns, by = slwidth)
        slend[ns] <- data[n, 1]
        condit <- c(data[, 1])
        choice <- slend
    }
    else stop("values of third parameter not valid")
    v <- matrix(0, ndim, ndim)
    ind <- rep(T, n)
    ndim <- ndim + 1
    j <- 1
    while (j <= ns) {
        sborder <- (condit <= choice[j]) & ind
        if (any(sborder)) {
            ind <- ind - sborder
            xslice <- data[sborder, 2:ndim]
            if (sum(sborder) == 1) {
                xmean <- xslice
                v <- v + outer(xmean, xmean, "*")
            }
            else {
                xmean <- apply(xslice, 2, mean)
                v <- v + outer(xmean, xmean, "*") * nrow(xslice)
            }
        }
        j <- j + 1
    }
    if (any(ind)) {
        print("Error:  elements unused !!")
        print(ind)
    }
    v <- (v + t(v))/(2 * n)
    eig <- eigen(v)
    b <- si2 %*% eig$vectors
    data <- sqrt(apply(b * b, 2, sum))
    b <- t(b)/data
    return(list(edr = t(b), evalues = eig$values))
  }

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