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
50
51
52
|
ehplot <-
function (data, groups, intervals = 50, offset = 0.1, log = FALSE,
median = TRUE, box = FALSE, boxborder = "grey50", xlab = "groups",
ylab = "values", col = "black", add = FALSE, sort = TRUE,
...)
{
stopifnot(length(data) == length(groups), is.numeric(data),
intervals > 0, offset < 0.4)
grps <- split(data, groups, drop = TRUE)
if (sort) {
grouporder <- 1:length(grps)
}
else {
grouporder <- rank(unique(groups))
}
dr <- range(data, finite = TRUE)
if (log) {
seps <- dr[1] * exp((0:intervals) * log(dr[2]/dr[1])/intervals)
}
else {
seps <- (0:intervals) * (diff(dr)/intervals) + dr[1]
}
inc <- rep(1:(0.4/offset), each = 2)
xshift <- list(even = c((inc - 0.5) * offset * (-1)^(1:length(inc))),
odd = c(0, inc * offset * (-1)^(1:length(inc))))
pnts_a <- list()
for (i in 1:length(grps)) {
tgrp <- grps[[grouporder[i]]]
histo <- hist(tgrp, breaks = seps, plot = FALSE)$counts
ixof <- unlist(sapply(histo, function(j) {
rep(xshift[[j%%2 + 1]], length.out = j)
}))
pnts_a[[i]] <- i + ixof[rank(tgrp, ties.method = "first")]
if (anyDuplicated(na.omit(cbind(tgrp, pnts_a[[i]]))))
warning("Some points are overplotted in group ",
names(grps)[grouporder[i]], ". Please consider using a lower offset-value.")
}
if (!add) {
plot(data, xlim = c(0.5, length(grps) + 0.5), xaxt = "n",
type = "n", xlab = xlab, ylab = ylab, log = ifelse(log,
"y", ""), ...)
axis(1, at = grouporder, labels = names(grps), ...)
}
if (box)
boxplot(data ~ groups, border = boxborder, at = grouporder,
add = TRUE, axes = FALSE, outline = FALSE)
points(unsplit(pnts_a[grouporder], groups, drop = TRUE),
data, col = col, ...)
if (median)
lines(rep(grouporder, each = 3) + c(-0.4, 0.4, NA), rep(sapply(grps,
median, na.rm = TRUE), each = 3) + c(0, 0, NA), lwd = 3)
}
|
