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