bwmcp:

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

Usage

bwmcp(J, K, x, tr = 0.2, JK = J * K, con = 0, alpha = 0.05, grp = c(1:JK), nboot = 599, SEED = TRUE, ...)

Arguments

J
K
x
tr
JK
con
alpha
grp
nboot
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 (J, K, x, tr = 0.2, JK = J * K, con = 0, alpha = 0.05, 
    grp = c(1:JK), nboot = 599, SEED = TRUE, ...) 
{
    if (is.matrix(x)) {
        y <- list()
        for (j in 1:ncol(x)) y[[j]] <- x[, j]
        x = y
    }
    conM = con2way(J, K)
    p <- J * K
    v <- matrix(0, p, p)
    data <- list()
    xx = list()
    for (j in 1:length(x)) {
        data[[j]] <- x[[grp[j]]]
        xx[[j]] = x[[grp[j]]]
        data[[j]] = data[[j]] - mean(data[[j]], tr = tr)
    }
    ilow = 0 - K
    iup = 0
    for (j in 1:J) {
        ilow <- ilow + K
        iup = iup + K
        sel <- c(ilow:iup)
        xx[sel] = listm(elimna(matl(xx[sel])))
        v[sel, sel] <- covmtrim(xx[sel], tr)
    }
    A = lindep(xx, conM$conA, cmat = v, tr = tr)$test.stat
    B = lindep(xx, conM$conB, cmat = v, tr = tr)$test.stat
    AB = lindep(xx, conM$conAB, cmat = v, tr = tr)$test.stat
    x <- data
    jp <- 1 - K
    kv <- 0
    if (SEED) 
        set.seed(2)
    nvec <- NA
    testA = NA
    testB = NA
    testAB = NA
    bsam = list()
    bdat = list()
    aboot = matrix(NA, nrow = nboot, ncol = ncol(conM$conA))
    bboot = matrix(NA, nrow = nboot, ncol = ncol(conM$conB))
    abboot = matrix(NA, nrow = nboot, ncol = ncol(conM$conAB))
    for (ib in 1:nboot) {
        ilow <- 1 - K
        iup = 0
        for (j in 1:J) {
            ilow <- ilow + K
            iup = iup + K
            nv = length(xx[[ilow]])
            bdat[[j]] = sample(nv, size = nv, replace = T)
            for (k in ilow:iup) {
                bsam[[k]] = data[[k]][bdat[[j]]]
            }
        }
        ilow = 0 - K
        iup = 0
        for (j in 1:J) {
            ilow <- ilow + K
            iup = iup + K
            sel <- c(ilow:iup)
            v[sel, sel] <- covmtrim(bsam[sel], tr)
        }
        temp = abs(lindep(bsam, conM$conA, cmat = v, tr = tr)$test.stat[, 
            4])
        aboot[ib, ] = temp
        testA[ib] = max(temp)
        temp = abs(lindep(bsam, conM$conB, cmat = v, tr = tr)$test.stat[, 
            4])
        bboot[ib, ] = temp
        testB[ib] = max(temp)
        temp = abs(lindep(bsam, conM$conAB, cmat = v, tr = tr)$test.stat[, 
            4])
        testAB[ib] = max(temp)
        abboot[ib, ] = temp
    }
    pbA = NA
    pbB = NA
    pbAB = NA
    for (j in 1:ncol(aboot)) pbA[j] = mean((abs(A[j, 4]) < aboot[, 
        j]))
    for (j in 1:ncol(bboot)) pbB[j] = mean((abs(B[j, 4]) < bboot[, 
        j]))
    for (j in 1:ncol(abboot)) pbAB[j] = mean((abs(AB[j, 4]) < 
        abboot[, j]))
    critA = sort(testA)
    critB = sort(testB)
    critAB = sort(testAB)
    ic <- floor((1 - alpha) * nboot)
    critA = critA[ic]
    critB = critB[ic]
    critAB = critAB[ic]
    cr = matrix(critA, ncol = 1, nrow = nrow(A))
    dimnames(cr) <- list(NULL, c("crit.value"))
    A = cbind(A, cr)
    pv = matrix(pbA, ncol = 1, nrow = nrow(A))
    dimnames(pv) <- list(NULL, c("p.value"))
    A = cbind(A, pv)
    cr = matrix(critB, ncol = 1, nrow = nrow(B))
    dimnames(cr) <- list(NULL, c("crit.value"))
    B = cbind(B, cr)
    pv = matrix(pbB, ncol = 1, nrow = nrow(B))
    dimnames(pv) <- list(NULL, c("p.value"))
    B = cbind(B, pv)
    cr = matrix(critAB, ncol = 1, nrow = nrow(AB))
    dimnames(cr) <- list(NULL, c("crit.value"))
    AB = cbind(AB, cr)
    pv = matrix(pbAB, ncol = 1, nrow = nrow(AB))
    dimnames(pv) <- list(NULL, c("p.value"))
    AB = cbind(AB, pv)
    list(Fac.A = A, Fac.B = B, Fac.AB = AB, contrast.coef = conM)
  }

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