rmmcppbtm:

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

Usage

rmmcppbtm(x, alpha = 0.05, con = 0, tr = 0.2, grp = NA, nboot = NA)

Arguments

x
alpha
con
tr
grp
nboot

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, alpha = 0.05, con = 0, tr = 0.2, grp = NA, nboot = NA) 
{
    if (!is.list(x) && !is.matrix(x)) 
        stop("Data must be stored in a matrix or in list mode.")
    if (is.list(x)) {
        if (is.matrix(con)) {
            if (length(x) != nrow(con)) 
                stop("The number of rows in con is not equal to the number of groups.")
        }
    }
    if (is.list(x)) {
        mat <- matrix(0, length(x[[1]]), length(x))
        for (j in 1:length(x)) mat[, j] <- x[[j]]
    }
    if (is.matrix(x) && is.matrix(con)) {
        if (ncol(x) != nrow(con)) 
            stop("The number of rows in con is not equal to the number of groups.")
        mat <- x
    }
    if (is.matrix(x)) 
        mat <- x
    if (!is.na(sum(grp))) 
        mat <- mat[, grp]
    mat <- elimna(mat)
    J <- ncol(mat)
    Jm <- J - 1
    if (sum(con^2) == 0) {
        d <- (J^2 - J)/2
        con <- matrix(0, J, d)
        id <- 0
        for (j in 1:Jm) {
            jp <- j + 1
            for (k in jp:J) {
                id <- id + 1
                con[j, id] <- 1
                con[k, id] <- 0 - 1
            }
        }
    }
    d <- ncol(con)
    if (is.na(crit) && tr != 0.2) {
        print("A critical value must be specified when")
        stop("the amount of trimming differs from .2")
    }
    if (is.na(nboot)) {
        if (d <= 3) 
            nboot <- 1000
        if (d == 6) 
            nboot <- 2000
        if (d == 10) 
            nboot <- 4000
        if (d == 15) 
            nboot <- 8000
        if (d == 21) 
            nboot <- 8000
        if (d == 28) 
            nboot <- 10000
    }
    n <- nrow(mat)
    crit <- NA
    if (alpha == 0.05) {
        if (d == 1) 
            crit <- alpha/2
        if (d == 3) {
            crit <- 0.004
            if (n >= 15) 
                crit <- 0.006
            if (n >= 30) 
                crit <- 0.007
            if (n >= 40) 
                crit <- 0.008
            if (n >= 100) 
                crit <- 0.009
        }
        if (d == 6) {
            crit <- 0.001
            if (n >= 15) 
                crit <- 0.002
            if (n >= 20) 
                crit <- 0.0025
            if (n >= 30) 
                crit <- 0.0035
            if (n >= 40) 
                crit <- 0.004
            if (n >= 60) 
                crit <- 0.0045
        }
        if (d == 10) {
            crit <- 0.00025
            if (n >= 15) 
                crit <- 0.00125
            if (n >= 20) 
                crit <- 0.0025
        }
        if (d == 15) {
            crit <- 5e-04
            if (n >= 20) 
                crit <- 0.001
            if (n >= 30) 
                crit <- 0.0011
            if (n >= 40) 
                crit <- 0.0016
            if (n >= 100) 
                crit <- 0.0019
        }
        if (d == 21) {
            crit <- 0.00025
            if (n >= 20) 
                crit <- 0.00037
            if (n >= 30) 
                crit <- 0.00075
            if (n >= 40) 
                crit <- 0.00087
            if (n >= 60) 
                crit <- 0.00115
            if (n >= 100) 
                crit <- 0.00125
        }
        if (d == 28) {
            crit <- 4e-04
            if (n >= 30) 
                crit <- 6e-04
            if (n >= 60) 
                crit <- 8e-04
            if (n >= 100) 
                crit <- 0.001
        }
    }
    if (is.na(crit)) {
        crit <- alpha/(2 * d)
        if (n < 20) 
            crit <- crit/2
        if (n <= 10) 
            crit <- crit/2
    }
    icl <- ceiling(crit * nboot) + 1
    icu <- ceiling((1 - crit) * nboot)
    connum <- ncol(con)
    set.seed(2)
    xbars <- matrix(0, nboot, ncol(mat))
    psihat <- matrix(0, connum, nboot)
    print("Taking bootstrap samples. Please wait.")
    bvec <- bootdep(mat, tr, nboot)
    test <- 1
    for (ic in 1:connum) {
        psihat[ic, ] <- apply(bvec, 1, bptdpsi, con[, ic])
        test[ic] <- sum((psihat[ic, ] > 0))/nboot
        test[ic] <- min(test[ic], 1 - test[ic])
    }
    print("Reminder: Test statistic must be less than critical value in order to reject.")
    output <- matrix(0, connum, 5)
    dimnames(output) <- list(NULL, c("con.num", "psihat", "test", 
        "ci.lower", "ci.upper"))
    tmeans <- apply(mat, 2, mean, trim = tr)
    psi <- 1
    for (ic in 1:ncol(con)) {
        output[ic, 2] <- sum(con[, ic] * tmeans)
        output[ic, 1] <- ic
        output[ic, 3] <- test[ic]
        temp <- sort(psihat[ic, ])
        output[ic, 4] <- temp[icl]
        output[ic, 5] <- temp[icu]
    }
    list(output = output, crit = crit, con = con)
  }

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