linpbg:

Usage Arguments Examples

Usage

1
linpbg(x, con = 0, alpha = 0.05, nboot = NA, est = mest, ...)

Arguments

x
con
alpha
nboot
est
...

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
##---- 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, con = 0, alpha = 0.05, nboot = NA, est = mest, ...) 
{
    con <- as.matrix(con)
    if (is.matrix(x)) 
        x <- listm(x)
    if (!is.list(x)) 
        stop("Data must be stored in a matrix or in list mode.")
    J <- length(x)
    for (j in 1:J) {
        xx <- x[[j]]
        xx[[j]] <- xx[!is.na(xx)]
    }
    Jm <- J - 1
    d <- (J^2 - J)/2
    if (sum(con^2) == 0) {
        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
            }
        }
    }
    if (nrow(con) != length(x)) {
        stop("The number of groups does not match the number of contrast coefficients.")
    }
    if (is.na(nboot)) {
        nboot <- 5000
        if (ncol(con) <= 4) 
            nboot <- 2000
    }
    m1 <- matrix(0, nrow = J, ncol = nboot)
    set.seed(2)
    print("Taking bootstrap samples. Please wait.")
    for (j in 1:J) {
        paste("Working on group ", j)
        data <- matrix(sample(x[[j]], size = length(x[[j]]) * 
            nboot, replace = TRUE), nrow = nboot)
        m1[j, ] <- apply(data, 1, est, ...)
    }
    testb <- NA
    boot <- matrix(0, ncol(con), nboot)
    testvec <- NA
    for (d in 1:ncol(con)) {
        boot[d, ] <- apply(m1, 2, trimpartt, con[, d])
        testb[d] <- sum((boot[d, ] > 0))/nboot
        testvec[d] <- min(testb[d], 1 - testb[d])
    }
    dd <- ncol(con)
    if (alpha == 0.05) {
        if (dd == 1) 
            crit <- alpha/2
        if (dd == 2) 
            crit <- 0.014
        if (dd == 3) 
            crit <- 0.0085
        if (dd == 4) 
            crit <- 0.007
        if (dd == 5) 
            crit <- 0.006
        if (dd == 6) 
            crit <- 0.0045
        if (dd == 10) 
            crit <- 0.0023
        if (dd == 15) 
            crit <- 0.0016
    }
    else {
        crit <- alpha/(2 * dd)
    }
    icl <- round(crit * nboot)
    icu <- round((1 - crit) * nboot)
    psihat <- matrix(0, ncol(con), 4)
    test <- matrix(0, ncol(con), 3)
    dimnames(psihat) <- list(NULL, c("con.num", "psihat", "ci.lower", 
        "ci.upper"))
    dimnames(test) <- list(NULL, c("con.num", "test", "crit.val"))
    for (d in 1:ncol(con)) {
        test[d, 1] <- d
        psihat[d, 1] <- d
        testit <- lincon(x, con[, d], tr)
        test[d, 2] <- testvec[d]
        temp <- sort(boot[d, ])
        psihat[d, 3] <- temp[icl]
        psihat[d, 4] <- temp[icu]
        psihat[d, 2] <- testit$psihat[1, 2]
        test[d, 3] <- crit
    }
    list(psihat = psihat, test = test, con = con)
  }

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