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
|
# $Id: contrMat.R,v 1.19 2003/12/19 09:34:41 hothorn Exp $
contrMat <- function(n, type = c("Dunnett", "Tukey", "Sequen", "AVE",
"Changepoint", "Williams", "Marcus",
"McDermott"), base = 1) {
if (length(n) < 2) stop("less than 2 groups")
m <- NULL
type <- match.arg(type)
k <- length(n)
if (base < 1 || base > k) stop("base is not between 1 and ", k)
CM <- c()
rnames <- c()
if (!is.null(names(n)))
varnames <- names(n)
else
varnames <- 1:length(n)
kindx <- 1:k
switch(type, "Dunnett" = {
for(i in kindx[-base])
CM <- rbind(CM, as.numeric(kindx == i) - as.numeric( kindx == base))
rnames <- paste(varnames[kindx[-base]], "-", varnames[base])
}, "Tukey" = {
for (i in 1:(k-1)) {
for(j in (i+1):k) {
CM <- rbind(CM, as.numeric(kindx==j)-as.numeric(kindx==i))
rnames <- c(rnames, paste(varnames[j], "-", varnames[i]))
}
}
}, "Sequen" = {
for (i in 2:k) {
CM <- rbind(CM, as.numeric(kindx==i)-as.numeric(kindx==i-1))
rnames <- c(rnames, paste(varnames[i], "-", varnames[i-1]))
}
}, "AVE" = {
help <- c(1, -n[2:k]/sum(n[2:k]))
CM <- rbind(CM, help)
for (i in 2:(k-1)) {
x <- sum(n[1:(i-1)])+sum(n[(i+1):k])
help <- c(-n[1:(i-1)]/x, 1, -n[(i+1):k]/x)
CM <- rbind(CM, help)
}
help <- c(-n[1:(k-1)]/sum(n[1:(k-1)]), 1)
CM <- rbind(CM, help)
rnames <- paste("C", 1:nrow(CM))
}, "Changepoint" = {
for (i in 1:(k-1)) {
help <- c(-n[1:i]/sum(n[1:i]), n[(i+1):k]/sum(n[(i+1):k]))
CM <- rbind(CM, help)
}
rnames <- c(rnames, paste("C", 1:nrow(CM)))
}, "Williams" = {
for (i in 1:(k-2)) {
help <- c(-1, rep(0, k-i-1), n[(k-i+1):k]/sum(n[(k-i+1):k]))
CM <- rbind(CM, help)
}
help <- c(-1, n[2:k]/sum(n[2:k]))
CM <- rbind(CM, help)
rnames <- c(rnames, paste("C", 1:nrow(CM)))
}, "Marcus" = {
cm1 <- matrix(0, nrow=k-1, ncol=k)
cm2 <- cm1
for (i in 1:(k-1)) {
cm1[i,(i+1):k] <- n[(i+1):k]/sum(n[(i+1):k])
cm2[i,1:i] <- n[1:i]/sum(n[1:i])
}
### row <- k*(k-1)/2
index <- 1
for (i in 1:(k-1)) {
for (j in 1:i) {
help <- cm1[i,]-cm2[j,]
CM <- rbind(CM, help)
index <- index+1
}
}
rnames <- c(rnames, paste("C", 1:nrow(CM)))
}, "McDermott" = {
for(i in 1:(k-2)) {
help <- c(-n[1:i]/sum(n[1:i]), 1, rep(0, k-i-1))
CM <- rbind(CM, help)
}
help <- c(-n[1:(k-1)]/sum(n[1:(k-1)]), 1)
CM <- rbind(CM, help)
rnames <- c(rnames, paste("C", 1:nrow(CM)))
}, "Tetrade" = {
if (is.null(m)) stop(sQuote("m"), " is missing")
a <- length(n)
b <- length(m)
if (!is.null(names(m)))
varnamesm <- names(m)
else
varnamesm <- 1:length(m)
idi <- 1:a
idj <- 1:b
for (i1 in 1:(a-1)) {
for (i2 in (i1+1):a) {
for (j1 in 1:(b-1)) {
for (j2 in (j1+1):b) {
CM <- rbind(CM, kronecker( ( as.numeric(idi==i1)-as.numeric(idi==i2) ),
( as.numeric(idj==j1)-as.numeric(idj==j2) ) ) )
rnames <- c(rnames, paste( "(", paste(varnames[i1], varnamesm[j1], sep = ":"), "-",
paste(varnames[i1], varnamesm[j2], sep = ":"), ")", "-",
"(", paste(varnames[i2], varnamesm[j1], sep = ":"), "-",
paste(varnames[i2], varnamesm[j2], sep = ":"), ")", sep=""))
}
}
}
}
},)
rownames(CM) <- rnames
if (type == "Tetrade")
colnames(CM) <- NULL ###levels(interaction(varnames, varnamesm))
else
colnames(CM) <- varnames
attr(CM, "type") <- type
class(CM) <- c("contrMat", "matrix")
CM
}
|
