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
| sorted.boxplot <- function(x , factor.levels, groups = NULL, ...){
res <- tapply(x , factor.levels, FUN = mean)
res.order <- as.character(10 * rank(res))
if(any(nchar(res.order)) > 3) {
stop("There are too many levels to sort!")
}
label3 <- label1 <- names(res)
for (i in 1:length(res.order)){
if( nchar(res.order[i]) == 2) {
label3[i] <- paste("0", res.order[i], sep = "")
}
if( nchar(res.order[i]) == 3) {
label3[i] <- paste(res.order[i], sep = "")
}
}
lab.ref <- data.frame(label1, label3)
label2 <- as.character(factor.levels)
tab2 <- data.frame(label2)
colnames(tab2) <- c("species")
dat2 <- data.frame(x, factor.levels)
colnames(dat2) <- c("Metric", "species")
res.tab <- merge(x = dat2, y = lab.ref,
by.x = "species", by.y = "label1" , all = TRUE)
res.tab$factors <- paste(substring(as.character(res.tab$label3), 1, 2),
res.tab$species, sep = " ")
if(!is.null(groups)){
xxx <- sort(unique(res.tab$factors))
tab.col <- data.frame(xxx, substring(xxx, 4, nchar(xxx)))
colnames(tab.col) <- c("Sorted", "species")
col.groups <- unique(data.frame(factor.levels, groups))
xxx2 <- merge(x = tab.col, y = col.groups, by.x = "species", by.y = "factor.levels")
ressss <- xxx2[order(xxx2$Sorted), ]
ressss$cols <- as.numeric(ressss$groups)
colors.n <- topo.colors(length(unique(ressss$cols)))
col.res <- data.frame(unique(ressss$cols), colors.n)
colnames(col.res) <- c("level", "color")
xxx3 <- merge(x = ressss, y = col.res, by.x = "cols", by.y = "level")
xxx3 <- xxx3[order(xxx3$Sorted), ]
boxplot(Metric ~ factors, data = res.tab, col = as.character(xxx3$color), ...)
legend.dat <- unique(data.frame(xxx3$groups, xxx3$color))
legend.label <- as.character(legend.dat[,1])
legend.col <- as.character(legend.dat[,2])
legend(length(xxx)/100, max(x), legend = legend.label, pch = 15, col = legend.col)
} else {
boxplot(Metric ~ factors, data = res.tab, ...)
}
}
|