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
|
enumerateAnovaModelsWithMain<-function(factors){
nFactors = length(factors)
mb = monotoneBooleanNice(nFactors)
mb = mb[-c(1,2),-ncol(mb)]
myModels = apply(mb,1,function(v) rev(((length(v):1))[v]))
myTerms = sapply(1:(2^nFactors-1),makeTerm,factors=factors)
lapply(myModels, function(v) myTerms[v])
}
enumerateAnovaModels = function(fmla, whichModels, data){
trms <- attr(terms(fmla, data = data), "term.labels")
ntrms <- length(trms)
dv = stringFromFormula(fmla[[2]])
dv = composeTerm(dv)
if(ntrms == 1 ) whichModels = "all"
if(whichModels=="top"){
lst = combn2( trms, ntrms - 1 )
}else if(whichModels=='bottom'){
lst = as.list(combn( trms, 1 ))
}else if(whichModels=="all"){
lst = combn2( trms, 1 )
}else if(whichModels=="withmain"){
lst = enumerateAnovaModelsWithMain( fmlaFactors(fmla, data)[-1] )
}else{
stop("Unknown whichModels value: ",whichModels)
}
strng <- sapply(lst,function(el){
paste(el,collapse=" + ")
})
strng <- unique(strng)
fmla <- lapply(strng, function(el){
formula(paste(dv,"~", el))
})
return(fmla)
}
createFixedAnovaModel <- function(dataTypes, formula){
fixedFactors <- names(dataTypes[dataTypes=="fixed"])
fixedPart <- paste(composeTerms(fixedFactors),collapse="*")
# get LHS of formula
dv = stringFromFormula(formula[[2]])
dv = composeTerm(dv)
formula(paste(dv, "~", fixedPart, collapse=""))
}
addRandomModelPart <- function(formula, dataTypes, null = FALSE){
randomFactors <- names(dataTypes[dataTypes=="random"])
randomPart <- paste(randomFactors,collapse="+")
fmla = stringFromFormula(formula)
dv = stringFromFormula(formula[[2]])
dv = composeTerm(dv)
if(null){
ret = formula(paste(dv, "~", randomPart, collapse=""))
}else{
ret = formula(paste(fmla, "+", randomPart, collapse=""))
}
return(ret)
}
|
