1DanielPlot <- 2function (fit, code = FALSE, faclab = NULL, block = FALSE, datax = TRUE, 3 half = FALSE, pch = "*", cex.fac = par("cex.lab"), cex.lab = par("cex.lab"), 4 cex.pch = par("cex.axis"), ...) 5{ 6 if (any(names(coef(fit)) == "(Intercept)")) { 7 factor.effects <- 2 * coef(fit)[-1] 8 } 9 else { 10 factor.effects <- 2 * coef(fit) 11 } 12 names(factor.effects) <- attr(fit$terms, "term.labels") 13 factor.effects <- factor.effects[!is.na(factor.effects)] 14 if (half) { 15 tn <- data.frame(x = qnorm(0.5 * ((rank(abs(factor.effects)) - 16 0.5)/length(factor.effects) + 1)), x = abs(factor.effects)) 17 names(tn$x) <- names(factor.effects) 18 xlab <- "half-normal score" 19 ylab <- "absolute effects" 20 } 21 else { 22 tn <- qqnorm(factor.effects, plot = FALSE) 23 xlab <- "normal score" 24 ylab <- "effects" 25 } 26 if (datax) { 27 tmp <- tn$x 28 tn$x <- tn$y 29 tn$y <- tmp 30 tmp <- xlab 31 xlab <- ylab 32 ylab <- tmp 33 } 34 labx <- names(factor.effects) 35 laby <- 1:length(tn$y) 36 points.labels <- names(factor.effects) 37 plot.default(tn, xlim = c(min(tn$x), max(tn$x) + diff(range(tn$x))/5), 38 pch = pch, xlab = xlab, ylab = ylab, cex.lab = cex.lab, 39 ...) 40 if (is.null(faclab)) { 41 if (!code) { 42 effect.code <- labx 43 } 44 else { 45 terms.ord <- attr(fit$terms, "order") 46 max.order <- max(terms.ord) 47 no.factors <- length(terms.ord[terms.ord == 1]) 48 factor.label <- attr(fit$terms, "term.labels")[1:no.factors] 49 factor.code <- LETTERS[1:no.factors] 50 if (block) 51 factor.code <- c("BK", factor.code) 52 texto <- paste(factor.code[1], "=", factor.label[1]) 53 for (i in 2:no.factors) { 54 texto <- paste(texto, ", ", factor.code[i], "=", 55 factor.label[i]) 56 } 57 mtext(side = 1, line = 2.5, texto, cex = cex.fac) 58 get.sep <- function(string, max.order) { 59 k <- max.order - 1 60 get.sep <- rep(0, k) 61 j <- 1 62 for (i in 1:nchar(string)) { 63 if (substring(string, i, i) == ":") { 64 get.sep[j] <- i 65 if (j == k) 66 break 67 j <- j + 1 68 } 69 } 70 get.sep 71 } 72 labeling <- function(string, get.sep, max.order, 73 factor.code, factor.label) { 74 labeling <- "" 75 sep <- get.sep(string, max.order) 76 sep <- sep[sep > 0] 77 n <- length(sep) + 1 78 if (n > 1) { 79 sep <- c(0, sep, nchar(string) + 1) 80 for (i in 1:n) { 81 labeling <- paste(labeling, sep = "", factor.code[factor.label == 82 substring(string, sep[i] + 1, sep[i + 1] - 83 1)][1]) 84 } 85 } 86 else labeling <- paste(labeling, sep = "", factor.code[factor.label == 87 string][1]) 88 labeling 89 } 90 effect.code <- rep("", length(terms.ord)) 91 for (i in 1:length(terms.ord)) { 92 effect.code[i] <- labeling(names(tn$x)[i], get.sep, 93 max.order, factor.code, factor.label) 94 } 95 } 96 text(tn, paste(" ", effect.code), cex = cex.pch, adj = 0, 97 xpd = NA) 98 } 99 else { 100 if (!is.list(faclab)) 101 stop("* Argument 'faclab' has to be NULL or a list with idx and lab objects") 102 text(tn$x[faclab$idx], tn$y[faclab$idx], labels = faclab$lab, 103 cex = cex.fac, adj = 0) 104 } 105 invisible(cbind(as.data.frame(tn), no = 1:length(tn$x))) 106} 107