[R] how to suppress whiskers in a bwplot?

[Alexis J. Diamond]

dear R-help,

i have looked carefully through the R-help archives for information on how
to suppress whiskers in a bwplot.  someone asked this question a while
ago, but the answer he received is not available in the archives.

but i did manage to get my hands on a panel function (called
"my.panel") that is supposed to do this (the function is reproduced at the
end of the email, below).  the problem is that i get an error message
when i use it in the following way:

####
data(singer)

bwplot(voice.part ~ height, data=singer, xlab="Height (inches)",
     panel = "my.panel")
####

### the error message is:

Error in segments(x1 = structure(c(NA, NA, NA, NA), .Names = c("", "",  :
        Argument "x0" is missing, with no default

###

i don't know if the problem is this panel function, or how I am
(mis)using it.
(i've never used a homegrown lattice panel function before.)

i realize that there is an excellent function in Hmisc that generates cool
bwplots sans whiskers, but those plots are too fancy for my
current needs.

all i need are regular boxy bwplots without whiskers
(or umbrellas, as i guess they're also called).

as a quick fix, i've also tried changing the color of the whiskers to the
background color to make the whiskers invisible, but this doesn't work
well when the whiskers perfectly align with the border of the box.

thank you for your help,

alexis diamond
adiamond at fas.harvard.edu


###  my.panel, the function that I've been told can suppress whiskers,
###  when outline = F

my.panel <- function(x, y, box.ratio = 1, font = box.dot$font, pch = box.dot$pch,
 cex = box.dot$cex, col = box.dot$col, outline = T, ...)
{
 ok <- !is.na(x) & !is.na(y)
 x <- x[ok]
 y <- y[ok]
 y.unique <- sort(unique(y))
 width <- box.ratio/(1 + box.ratio)
 w <- width/2
 e <- par("cxy")[1]
 for(Y in y.unique) {
  X <- x[y == Y]
  q <- quantile(X, c(0.75, 0.5, 0.25))
  iqr <- q[1] - q[3]
  d <- q[c(1, 3)] + c(1, -1) * 1.5 * iqr
  up.w <- max(X[X <= d[1]], q[1])
  lo.w <- min(X[X >= d[2]], q[3])
  outliers <- X[X < lo.w | X > up.w]
  X <- c(up.w, q, lo.w)
  median.value <- list(x = X[3], y = Y)
  Box <- list(x1 = X[c(2, 4, 4, 2)], y1 = Y + c( - w,
    - w, w, w), x2 = X[c(4, 4, 2, 2)], y2 = Y +
   c( - w, w, w,  - w))
  e <- par("cxy")[1]
  e.l <- min(e, (X[4] - X[5])/2)
  # prevent lower staple ends from touching box
  e.u <- min(e, (X[1] - X[2])/2)
  # prevent upper staple ends from touching box
  staple.ends <- list(x1 = rep(c(X[5], max(X[1] - e.u,
   X[2])), 2), y1 = c(rep(Y - w, 2), rep(Y + w,
   2)), x2 = rep(c(min(X[5] + e.l, X[4]), X[1]),
   2), y2 = c(rep(Y - w, 2), rep(Y + w, 2)))
  staple.body <- list(x1 = X[c(1, 5)], y1 = rep(Y - w,
   2), x2 = X[c(1, 5)], y2 = rep(Y + w, 2))
  dotted.line <- list(x1 = X[c(1, 4)], y1 = c(Y, Y),
   x2 = X[c(2, 5)], y2 = c(Y, Y))
  box.umbrella <- trellis.par.get("box.umbrella")
  box.dot <- trellis.par.get("box.dot")
  box.dot.par <- c(list(pch = pch, cex = cex, col = col,
   font = font), ...)
  do.call("segments", c(staple.ends, box.umbrella))
  do.call("segments", c(staple.body, box.umbrella))
  do.call("segments", c(dotted.line, box.umbrella))
  do.call("segments", c(Box, trellis.par.get(
   "box.rectangle")))
  do.call("points", c(median.value, box.dot.par))
  if(outline & length(outliers) > 0) {
   outliers <- list(x = outliers, y = rep(Y,
    length(outliers)))
   do.call("points", c(outliers, trellis.par.get(
    "plot.symbol"), cex = cex))
  }
 }
}