| 1 | 
| x | |
| y | |
| xout | |
| outfun | |
| STAND | |
| alpha | |
| pr | |
| BLO | |
| HC3 | |
| ... | 
| 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 | ##---- 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, xout = TRUE, outfun = outpro, STAND = TRUE, alpha = 0.05, 
    pr = TRUE, BLO = FALSE, HC3 = FALSE, ...) 
{
    if (!is.list(x)) 
        stop("Argument x should have list mode")
    if (!is.list(y)) 
        stop("Argument y should have list mode")
    J = length(x)
    x = lapply(x, as.matrix)
    pchk = lapply(x, ncol)
    temp = matl(pchk)
    if (var(as.vector(temp)) != 0) 
        stop("Something is wrong. \nNumber of covariates differs among the groups being compared")
    nv = NULL
    p = ncol(x[[1]])
    p1 = p + 1
    for (j in 1:J) {
        xy = elimna(cbind(x[[j]], y[[j]]))
        x[[j]] = xy[, 1:p]
        y[[j]] = xy[, p1]
        x[[j]] = as.matrix(x[[j]])
        nv = c(nv, nrow(x[[j]]))
    }
    nv.keep = nv
    critrad = NULL
    if (xout) {
        temp = lapply(x, outfun, plotit = FALSE, STAND = STAND, 
            ...)
        for (j in 1:J) {
            x[[j]] = x[[j]][temp[[j]]$keep, ]
            y[[j]] = y[[j]][temp[[j]]$keep]
        }
    }
    tot = (J^2 - J)/2
    dvec <- alpha/c(1:tot)
    outl = list()
    nr = tot * p1
    outp = matrix(NA, ncol = 7, nrow = nr)
    x = lapply(x, as.matrix)
    rlab = rep("Intercept", tot)
    xx = list()
    yy = list()
    iall = 0
    ivp = c(1, tot) - tot
    for (ip in 1:p1) {
        iv = ip - 1
        i = 0
        if (iv > 0) 
            rlab = c(rlab, rep(paste("slope", iv), tot))
        for (j in 1:J) {
            for (k in 1:J) {
                if (j < k) {
                  i = i + 1
                  xx[[1]] = x[[j]][, 1:p]
                  xx[[2]] = x[[k]][, 1:p]
                  yy[[1]] = y[[j]]
                  yy[[2]] = y[[k]]
                  all = olsW2g(xx, yy, iv = iv, BLO = BLO, HC3 = HC3)
                  temp = all$p.value
                  iall = iall + 1
                  outp[iall, 1] = j
                  outp[iall, 2] = k
                  outp[iall, 3] = all$conf.interval[1]
                  outp[iall, 4] = all$conf.interval[2]
                  outp[iall, 5] = temp
                }
            }
        }
        ivp = ivp + tot
        temp2 <- order(0 - outp[ivp[1]:ivp[2], 5])
        icc = c(ivp[1]:ivp[2])
        icc[temp2] = dvec
        outp[ivp[1]:ivp[2], 6] = icc
        D = rep("NO", tot)
        flag = (outp[ivp[1]:ivp[2], 5] <= outp[ivp[1]:ivp[2], 
            4])
    }
    flag = (outp[, 5] <= outp[, 6])
    outp[, 7] = rep(0, nr)
    outp[flag, 7] = 1
    dimnames(outp) = list(rlab, c("Group", "Group", "ci.low", 
        "ci.up", "p.value", "p.crit", "sig"))
    list(n = nv, n.keep = nv.keep, output = outp)
  }
 | 
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.