boxplot <- function(x, ..., range=1.5, width=NULL, varwidth=FALSE,
	notch=FALSE, names, data=sys.frame(sys.parent()),
	plot=TRUE, border=par("fg"), col=NULL, log="", pars=NULL)
{
	if(is.language(x)) {
		if(length(x) == 3 && deparse(x[[1]]) == '~') {      
			groups <- eval(x[[3]], data)
			x <- eval(x[[2]], data)
			groups <- split(x, groups)
		}
		else stop("invalid first argument")
		apars <- list(...)
		pars <- c(apars[named.elements(apars)], pars)
	}
	else {
		groups <- list(x, ...)
		n <- named.elements(groups)
		pars <- c(groups[n], pars)
		groups[n] <- NULL
		if(length(groups)==1 && is.list(x))
			groups <- x
	}
	n <- length(groups)
	if(!missing(names)) attr(groups, "names") <- names
	else if(is.null(attr(groups, "names"))) attr(groups, "names") <- 1:n
	for(i in 1:n)
		groups[i] <- list(boxplot.stats(groups[[i]], range))
	if(plot) {
		bxp(groups, width, varwidth=varwidth, notch=notch,
			border=border, col=col, log=log, pars=pars)
		invisible(groups)
	}
	else groups
}

boxplot.stats <- function(x, coef = 1.5)
{
	nna <- !is.na(x)
	n <- length(nna)
	stats <- fivenum(x, na.rm=TRUE)
	iqr <- diff(stats[c(2, 4)])
	out <- x < (stats[2]-coef*iqr) | x > (stats[4]+coef*iqr)
	if(coef > 0) stats[c(1, 5)] <- range(x[!out], na.rm=TRUE)
	conf <- stats[3]+c(-1.58, 1.58)*diff(stats[c(2, 4)])/sqrt(n)
	list(stats=stats, n=n, conf=conf, out=x[out&nna])
}

bxp <- function(z, notch=FALSE, width=NULL, varwidth=FALSE,
	border=par("fg"), col=NULL, log="", pars=NULL, ...)
{
	bplt <- function(x, wid, stats, out, conf, notch, border, col)
	{
		if(!any(is.na(stats))) {
			wid <- wid/2
			if(notch) {
				xx <- x+wid*c(-1,1,1,0.5,1,1,-1,-1,-0.5,-1)
				yy <- c(stats[c(2,2)],conf[1],stats[3],conf[2],
					stats[c(4,4)],conf[2],stats[3],conf[1])
				polygon(xx, yy, col=col, border=border)
				segments(x-wid/2, stats[3], x+wid/2, stats[3], col=border)
			}
			else {
				xx <- x+wid*c(-1,1,1,-1)
				yy <- stats[c(2,2,4,4)]
				polygon(xx, yy, col=col, border=border)
				segments(x-wid,stats[3],x+wid,stats[3],col=border)
			}
			segments(rep(x,2),stats[c(1,5)], rep(x,2), stats[c(2,4)], lty="dashed",col=border)
			segments(rep(x-wid/2,2),stats[c(1,5)],rep(x+wid/2,2), stats[c(1,5)],col=border)
			points(rep(x,length(out)), out, col=border)
		}
	}

	n <- length(z)
	limits <- numeric(0)
	nmax <- 0
	for(i in 1:n) {
		nmax <- max(nmax,z[[i]]$n)
		limits <- range(limits, z[[i]]$stats, z[[i]]$out)
	}
	if(!is.null(width)) {
		if(length(width) != n | any(is.na(width)) | any(width <= 0))
			stop("invalid boxplot widths")
		width <- 0.8*width/max(width)
	}
	else if(varwidth) {
		width <- 0.8*sqrt(z[[i]]$n/nmax)
	}
	if(n == 1) width <- 0.4
	else width <- rep(0.8,n)
	plot.new()
	plot.window(xlim=c(0.5,n+0.5), ylim=limits, log=log)
	for(i in 1:n) {
		if(missing(border) || length(border)==0)
			border <- par("fg")
		bplt(i,width[i],z[[i]]$stats,z[[i]]$out,
			z[[i]]$conf,notch=notch,
			border=border[(i-1)%%length(border)+1],
			col=if(is.null(col)) col
			else col[(i-1)%%length(col)+1])
	}
	if(n > 1) axis(1, at=1:n, labels=names(z))
	axis(2)
	do.call("title", c(pars, list(...)))
	box()
	invisible(1:n)
}
