1 |
J |
|
K |
|
x |
|
grp |
|
p |
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 (J, K, x, grp = c(1:p), p = J * K)
{
newx = list()
GV = matrix(c(1:p), ncol = K, byrow = TRUE)
if (is.list(x)) {
temp = NA
jk = 0
for (j in 1:J) {
temp = elimna(matl(x[GV[j, ]]))
for (k in 1:K) {
jk = jk + 1
newx[[jk]] = temp[, k]
}
}
x = NA
x = newx
}
if (is.matrix(x)) {
x = elimna(x)
x <- listm(x)
}
xx <- list()
nvec <- NA
for (j in 1:p) {
xx[[j]] <- x[[grp[j]]]
nvec[j] <- length(xx[[j]])
}
Nrow = nvec[GV[, 1]]
v <- matrix(0, p, p)
Ja <- matrix(1, J, J)
Ia <- diag(1, J)
Pa <- Ia - Ja/J
Jb <- matrix(1, K, K)
Ib <- diag(1, K)
Pb <- Ib - Jb/K
cona <- kron(Pa, Ib)
xr <- list()
N <- 0
jj = 0
for (k in 1:K) {
temp <- x[[k]]
jk <- k
for (j in 2:J) {
jj = jj + 1
jk <- jk + K
temp <- c(temp, x[[jk]])
}
N <- length(temp)
pr <- rank(temp)
xr[[k]] <- pr[1:nvec[k]]
top <- nvec[k]
jk <- k
bot <- 1
for (j in 2:J) {
jk <- jk + K
bot <- bot + nvec[jk]
top <- top + nvec[jk]
xr[[jk]] <- pr[bot:top]
}
}
phat <- NA
botk <- 0
for (j in 1:J) {
for (k in 1:K) {
botk <- botk + 1
phat[botk] <- (mean(xr[[botk]]) - 0.5)/N
}
}
klow <- 1 - K
kup <- 0
for (j in 1:J) {
klow <- klow + K
kup <- kup + K
sel <- c(klow:kup)
v[sel, sel] <- covmtrim(xr[klow:kup], tr = 0)/N
}
qhat <- matrix(phat, J, K, byrow = TRUE)
test <- N * t(phat) %*% cona %*% phat/sum(diag(cona %*% v))
nu1 <- sum(diag(cona %*% v))^2/sum(diag(cona %*% v %*% cona %*%
v))
sig.level <- 1 - pf(test, nu1, 1e+06)
list(test.stat = test[1, 1], nu1 = nu1, p.value = sig.level,
N = N, q.hat = qhat)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.