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}