1##Modified FEH 30Jun97 - delete missing data, names default to T,
2## auto names for list argument, ylab default to "" instead of Percentiles
3## names -> name, added srtx
4bpplot <- function(..., name = TRUE,
5                   main = "Box-Percentile Plot",
6                   xlab = "", ylab = "", srtx=0)
7{
8  all.x <- list(...)  ## FH 30Jun97
9  nam <- character(0)   ## FH
10  ## if(is.list(...)) {  ## FH
11  if(is.list(all.x[[1]])) {
12    all.x <- all.x[[1]]
13    if(is.logical(name) && name) name <- names(...)   ## FH
14  }
15
16  n <- length(all.x)
17  centers <- seq(from = 0, by = 1.2, length = n)
18  ymax <- max(sapply(all.x, max, na.rm=TRUE))  ## na.rm=T FEH
19  ymin <- min(sapply(all.x, min, na.rm=TRUE))
20  xmax <- max(centers) + 0.5
21  xmin <- -0.5
22  plot(c(xmin, xmax), c(ymin, ymax), type = "n", main = main,
23       xlab = '', ylab = ylab, xaxt = "n")
24  for(i in 1:n) {
25    plot.values <- bpx(all.x[[i]], centers[i])
26    lines(plot.values$x1, plot.values$y1)
27    lines(plot.values$x2, plot.values$y2)
28    lines(plot.values$q1.x, plot.values$q1.y)
29    lines(plot.values$q3.x, plot.values$q3.y)
30    lines(plot.values$med.x, plot.values$med.y)
31  }
32
33  if(is.logical(name)) {
34    if(name)
35      mgp.axis(1, centers,
36               sapply(substitute(list(...)), deparse)[2:(n + 1)],
37               srt=srtx,
38               adj=if(srtx==0).5
39                   else 1,
40               axistitle=xlab)
41  }
42  else mgp.axis(1, centers, name, srt=srtx,
43                adj=if(srtx==0).5
44                    else 1,
45                axistitle=xlab)
46
47  invisible(centers)
48}
49
50bpx <- function(y, offset)
51{
52  y <- y[!is.na(y)]   ## FEH 30Jun97
53  n <- length(y)
54  delta <- 1/(n + 1)
55  prob <- seq(delta, 1 - delta, delta)
56  quan <- sort(y)
57  med <- median(y)
58  q1 <- median(y[y < med])
59  q3 <- median(y[y > med])
60  first.half.p <- prob[quan <= med]
61  second.half.p <- 1 - prob[quan > med]
62  plotx <- c(first.half.p, second.half.p)
63
64  ## calculating the ends of the first quartile line
65
66  qx <- approx(quan, plotx, xout = q1)$y
67  q1.x <- c( - qx, qx) + offset
68
69  ## calculating the ends of the third quartile line
70
71  qx <- approx(quan, plotx, xout = q3)$y
72  q3.x <- c( - qx, qx) + offset
73  q1.y <- c(q1, q1)
74  q3.y <- c(q3, q3)
75  med.x <- c( - max(first.half.p), max(first.half.p)) + offset
76  med.y <- c(med, med)
77  return(list(x1 = ( - plotx) + offset, y1 = quan, x2 = plotx + offset,
78              y2 = quan, q1.y = q1.y, q1.x = q1.x, q3.y = q3.y, q3.x = q3.x,
79              med.y = med.y, med.x = med.x))
80}
81