1## utility functions in support of valid and readable
2## alias info in the summary for block and splitplot designs
3
4recalc.alias.block <- function(dia,leg){
5## dia is the aliased element of a blocked or split plot design without the legend element
6## leg is the separate legend element
7    hilf <- lapply(dia, function(obj) strsplit(obj, ":", fixed=TRUE))
8    leg <- lapply(leg, function(obj) unlist(strsplit(obj, "=", fixed=TRUE)))
9    leg.c <- sapply(leg, function(obj) obj[1])
10    leg.n <- sapply(leg, function(obj) obj[2])
11    hilf <- lapply(hilf, function(obj) lapply(obj, function(obj2) sort(leg.c[which(leg.n %in% obj2)])))
12    hilf <- lapply(hilf, function(obj) obj[ord(data.frame(sapply(obj, length)))])
13    unlist(sort(unlist(sapply(hilf, function(obj) {
14        ## vector of elements to be equated
15        hilf <- paste(sapply(obj, function(obj2) paste(obj2, collapse="")), collapse="=")
16        hilf[ord(data.frame(nchar(hilf), hilf))]
17        }
18        ))))
19}
20
21struc.aliased <- function(struc, nk, order){
22        ## nk distinguishes Letters (nk<=50) or F1, F2, ...
23        struc <- sapply(struc, function(obj) {
24            if (length(grep("^-", obj)) == 1) {
25                obj <- gsub("-", "~", obj)
26                obj <- gsub("=", "=-", obj)
27                obj <- gsub("=-~", "=", obj)
28                obj <- gsub("~", "", obj)
29            }
30            obj
31        })
32        names(struc) <- NULL
33        if (nk <= 50) {
34            wme <- grep("^[[:alpha:]]=[[:alpha:][:punct:]]*",
35                struc)
36            wme2 <- grep("^[[:alpha:]]{2}=[[:alpha:][:punct:]]*",
37                struc)
38            if (order == 3)
39                wme3 <- grep("^[[:alpha:]]{3}=[[:alpha:][:punct:]]*",
40                  struc)
41        }
42        else {
43            wme <- grep("^F[[:digit:]]+=F[[:digit:][:punct:]]*",
44                struc)
45            wme2 <- grep("^F[[:digit:]]+:F[[:digit:]]+=F[[:digit:][:punct:]]*",
46                struc)
47            if (order == 3)
48                wme3 <- grep("^F[[:digit:]]+:F[[:digit:]]+:F[[:digit:]]+=F[[:digit:][:punct:]]*",
49                  struc)
50        }
51        if (order == 2)
52            aus <- list(main = sort(struc[wme]), fi2 = sort(struc[wme2]))
53        else aus <- list(main = sort(struc[wme]), fi2 = sort(struc[wme2]),
54            fi3 = sort(struc[wme3]))
55    aus
56}