1 |
J |
|
K |
|
x |
|
tr |
|
grp |
|
p |
|
MAT |
|
lev.col |
|
var.col |
|
pr |
|
IV1 |
|
IV2 |
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 | ##---- 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, grp = c(1:p), p = J * K, MAT = FALSE,
lev.col = c(1:2), var.col = 3, pr = TRUE, IV1 = NULL, IV2 = NULL)
{
if (is.data.frame(x))
data = as.matrix(x)
if (tr == 0.5) {
print("For medians, use med2way if there are no ties")
print("With ties, use linear contrasts in conjunction with medpb")
stop("")
}
if (MAT) {
if (!is.matrix(x))
stop("With MAT=T, data must be a matrix")
if (length(lev.col) != 2)
stop("Argument lev.col should have 3 values")
temp = selby2(x, lev.col, var.col)
lev1 = length(unique(temp$grpn[, 1]))
lev2 = length(unique(temp$grpn[, 2]))
gv = apply(temp$grpn, 2, rank)
gvad = 10 * gv[, 1] + gv[, 2]
grp = rank(gvad)
if (pr) {
print(paste("Factor 1 has", lev1, "levels"))
print(paste("Factor 2 has", lev2, "levels"))
}
if (J != lev1)
warning("J is being reset to the number of levels found")
if (K != lev2)
warning("K is being reset to the number of levels found")
J = lev1
K = lev2
x = temp$x
}
if (!is.null(IV1[1])) {
if (is.null(IV2[1]))
stop("IV2 is NULL")
if (pr)
print("Assuming data is a vector containing all of the data; the dependent variable")
xi = elimna(cbind(x, IV1, IV2))
J = length(unique(xi[, 2]))
K = length(unique(xi[, 3]))
x = fac2list(xi[, 1], xi[, 2:3])
}
if (is.matrix(x))
x = listm(x)
if (!is.list(x))
stop("Data are not stored in list mode")
if (p != length(x)) {
print("The total number of groups, based on the specified levels, is")
print(p)
print("The number of groups is")
print(length(x))
print("Warning: These two values are not equal")
}
tmeans <- 0
h <- 0
v <- 0
for (i in 1:p) {
x[[grp[i]]] = elimna(x[[grp[i]]])
tmeans[i] <- mean(x[[grp[i]]], tr)
h[i] <- length(x[[grp[i]]]) - 2 * floor(tr * length(x[[grp[i]]]))
if (winvar(x[[grp[i]]], tr) == 0)
print(paste("The Winsorized variance is zero for group",
i))
v[i] <- (length(x[[grp[i]]]) - 1) * winvar(x[[grp[i]]],
tr)/(h[i] * (h[i] - 1))
}
v <- diag(v, p, p)
ij <- matrix(c(rep(1, J)), 1, J)
ik <- matrix(c(rep(1, K)), 1, K)
jm1 <- J - 1
cj <- diag(1, jm1, J)
for (i in 1:jm1) cj[i, i + 1] <- 0 - 1
km1 <- K - 1
ck <- diag(1, km1, K)
for (i in 1:km1) ck[i, i + 1] <- 0 - 1
cmat <- kron(cj, ik)
alval <- c(1:999)/1000
for (i in 1:999) {
irem <- i
Qa <- johan(cmat, tmeans, v, h, alval[i])
if (i == 1)
dfA = Qa$df
if (Qa$teststat > Qa$crit)
break
}
A.p.value = irem/1000
cmat <- kron(ij, ck)
for (i in 1:999) {
irem <- i
Qb <- johan(cmat, tmeans, v, h, alval[i])
if (i == 1)
dfB = Qb$df
if (Qb$teststat > Qb$crit)
break
}
B.p.value = irem/1000
cmat <- kron(cj, ck)
for (i in 1:999) {
irem <- i
Qab <- johan(cmat, tmeans, v, h, alval[i])
if (i == 1)
dfAB = Qab$df
if (Qab$teststat > Qab$crit)
break
}
AB.p.value = irem/1000
tmeans = matrix(tmeans, J, K, byrow = T)
list(Qa = Qa$teststat, A.p.value = A.p.value, df.A = dfA,
Qb = Qb$teststat, B.p.value = B.p.value, df.B = dfB,
Qab = Qab$teststat, AB.p.value = AB.p.value, df.AB = dfAB,
means = tmeans)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.