pbmcp:

Usage Arguments Examples

Usage

1
pbmcp(x, alpha = 0.05, nboot = NA, grp = NA, est = onestep, con = 0, bhop = FALSE, SEED = TRUE, ...)

Arguments

x
alpha
nboot
grp
est
con
bhop
SEED
...

Examples

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
##---- 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, nboot = NA, grp = NA, est = onestep, 
    con = 0, bhop = FALSE, SEED = TRUE, ...) 
{
    okay = FALSE
    if (identical(est, onestep)) 
        okay = TRUE
    if (identical(est, mom)) 
        okay = TRUE
    if (!okay) 
        stop("For estimators other than onestep and mom, use linconpb")
    con <- as.matrix(con)
    if (is.matrix(x)) 
        x <- listm(x)
    if (!is.list(x)) 
        stop("Data must be stored in list mode or in matrix mode.")
    if (!is.na(sum(grp))) {
        xx <- list()
        for (i in 1:length(grp)) xx[[i]] <- x[[grp[i]]]
        x <- xx
    }
    J <- length(x)
    tempn <- 0
    mvec <- NA
    for (j in 1:J) {
        temp <- x[[j]]
        temp <- temp[!is.na(temp)]
        tempn[j] <- length(temp)
        x[[j]] <- temp
        mvec[j] <- est(temp, ...)
    }
    nmax = max(tempn)
    Jm <- J - 1
    if (sum(con^2) == 0) {
        ncon <- (J^2 - J)/2
        con <- matrix(0, J, ncon)
        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
            }
        }
    }
    ncon <- ncol(con)
    if (nrow(con) != J) {
        stop("Something is wrong with con; the number of rows does not match the number of groups.")
    }
    if (is.na(nboot)) {
        nboot <- 5000
        if (J <= 8) 
            nboot <- 4000
        if (J <= 3) 
            nboot <- 2000
    }
    if (!bhop) {
        if (!identical(est, onestep)) 
            print("When est is not equal to  onestep, suggest using bhop=TRUE")
        if (alpha == 0.05) {
            dvec <- c(0.025, 0.025, 0.0169, 0.0127, 0.0102, 0.00851, 
                0.0073, 0.00639, 0.00568, 0.00511)
            if (ncon > 10) {
                avec <- 0.05/c(11:ncon)
                dvec <- c(dvec, avec)
            }
        }
        if (alpha == 0.01) {
            dvec <- c(0.005, 0.005, 0.00334, 0.00251, 0.00201, 
                0.00167, 0.00143, 0.00126, 0.00112, 0.00101)
            if (nmax >= 100) 
                dvec[1] = 0.01
            if (ncon > 10) {
                avec <- 0.01/c(11:ncon)
                dvec <- c(dvec, avec)
            }
        }
        if (alpha != 0.05 && alpha != 0.01) {
            dvec <- alpha/c(1:ncon)
            dvec[1] <- alpha/2
        }
        dvec <- 2 * dvec
    }
    if (nmax > 80) {
        if (alpha == 0.05) {
            dvec <- c(0.05, 0.025, 0.0169, 0.0127, 0.0102, 0.00851, 
                0.0073, 0.00639, 0.00568, 0.00511)
            if (ncon > 10) {
                avec <- 0.05/c(11:ncon)
                dvec <- c(dvec, avec)
            }
        }
        if (alpha == 0.01) {
            dvec <- c(0.01, 0.005, 0.00334, 0.00251, 0.00201, 
                0.00167, 0.00143, 0.00126, 0.00112, 0.00101)
            if (ncon > 10) {
                avec <- 0.01/c(11:ncon)
                dvec <- c(dvec, avec)
            }
        }
        if (alpha != 0.05 && alpha != 0.01) {
            dvec <- alpha/c(1:ncon)
        }
    }
    if (bhop) 
        dvec <- (ncon - c(1:ncon) + 1) * alpha/ncon
    bvec <- matrix(NA, nrow = J, ncol = nboot)
    if (SEED) 
        set.seed(2)
    for (j in 1:J) {
        data <- matrix(sample(x[[j]], size = length(x[[j]]) * 
            nboot, replace = TRUE), nrow = nboot)
        bvec[j, ] <- apply(data, 1, est, ...)
    }
    chkna = sum(is.na(bvec))
    if (chkna > 0) {
        print("Bootstrap estimates of location could not be computed")
        print("This can occur when using an M-estimator")
        print("Might try est=tmean")
    }
    test <- NA
    bcon <- t(con) %*% bvec
    tvec <- t(con) %*% mvec
    for (d in 1:ncon) {
        test[d] <- (sum(bcon[d, ] > 0) + 0.5 * sum(bcon[d, ] == 
            0))/nboot
        if (test[d] > 0.5) 
            test[d] <- 1 - test[d]
    }
    test <- 2 * test
    output <- matrix(0, ncon, 6)
    dimnames(output) <- list(NULL, c("con.num", "psihat", "p.value", 
        "p.crit", "ci.lower", "ci.upper"))
    temp2 <- order(0 - test)
    zvec <- dvec[1:ncon]
    sigvec <- (test[temp2] >= zvec)
    output[temp2, 4] <- zvec
    icl <- round(dvec[ncon] * nboot/2) + 1
    icu <- nboot - icl - 1
    for (ic in 1:ncol(con)) {
        output[ic, 2] <- tvec[ic, ]
        output[ic, 1] <- ic
        output[ic, 3] <- test[ic]
        temp <- sort(bcon[ic, ])
        output[ic, 5] <- temp[icl]
        output[ic, 6] <- temp[icu]
    }
    num.sig <- sum(output[, 3] <= output[, 4])
    list(output = output, con = con, num.sig = num.sig)
  }

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