.packageName <- "lvplot"
# Determine depth
# Determine number of letter values needed for n observations
# 
# @arguments number of observation to be shown in the LV boxplot
# @arguments number of letter value statistics used 
# @arguments if defined, depth k is calculated such that confidence intervals of an LV statistic do not extend into neighboring LV statistics
# @arguments if defined, depth k is adjusted such that \code{perc} percent outliers are shown
# @keyword internal 
determineDepth <- function(n, k, alpha,  perc) {
  if (!is.null(perc)) {
  	# we're aiming for perc percent of outlying points
  	k <- ceiling((log2(n))+1) - ceiling((log2(n*perc*0.01))+1)+1
  }
  if (is.null(k)) { 
  	# confidence intervals around an LV statistic 
  	# should not extend into surrounding LV statistics

  	k <- ceiling((log2(n))-log2(4*qnorm(alpha+(1-alpha)/2)^2))  
  }
  if (k < 1) k <- 1	
 
  return (k)
}
# LV summary table
# Create letter value summary table
# 
# @arguments numeric vector
# @arguments quantiles to compute
# @arguments number of letter statistics
# @arguments list of outliers
# @arguments depth of the corresponding LV statistic (i.e. how far from the outside do we have to go into the sorted data values?)
# @arguments significance level
# @value letter.val: letter value statistic, distinguishes between upper and lower LV statistic for all statistics but the median
# @value conf.int: confidence interval of corresponding letter value statistic
# @value out: list of defined outliers
# @keyword internal 
outputLVplot <- function(x,qu,k,out,depth,alpha) {
  low <- depth - floor(0.5 *sqrt(2*depth-1) * qnorm(alpha+(1-alpha)/2))
  high <- depth + ceiling(0.5 *sqrt(2*depth-1) * qnorm(alpha+(1-alpha)/2))
  n <- length(x)
  LV <- cbind(depth,lower=qu[k:1],upper=qu[k+1:k])
  y <- sort(x)
  conf <- cbind(c(y[rev(low[-1])],y[n-high]),c(y[rev(high[-1])],y[n-low]))
  colnames(conf) <- c(paste((1-alpha)/2*100,"%",sep=""),paste((alpha+(1-alpha)/2)*100,"%",sep=""))
  if (k > 1) {
    which <- (((k-1):1 + (6-k)) %% 26) + 1
    row.names(LV) <- c('M',toupper(letters[which]))
    row.names(conf) <- c(paste(toupper(letters[rev(which)]),"l",sep=""),'M',paste(toupper(letters[which]),"u",sep=""))
  } 
  if (k == 1) {
    row.names(LV) <- 'M'
    row.names(conf) <- 'M'
  }

  result <- list(letter.val = LV, conf.int= conf,outliers = x[out])
  return(result)
}

# Draw an LV plot 
# Draw a letter value boxplot
# 
# @arguments x positions
# @arguments y positions
# @arguments number of letter value statistics used
# @arguments out: outliers
# @arguments quantiles
# @arguments display horizontally (TRUE) or vertically (FALSE)
# @arguments vector of colours to use
# @keyword internal
drawLVplot <- function(x,y,k,out,qu,horizontal,col,...) {
  if (horizontal) { 
	points(x[out],rep(y,length(x[out])),pch=8)		
	# draw boxes:
	for (i in 1:k) 
		rect(qu[i], y+i/(2*k),qu[2*k-i+1], y-i/(2*k), col=col[i])
  } else { # draw vertical plot
	points(rep(y,length(x[out])),x[out],pch=8)						 
	# draw boxes:
	for (i in 1:k) 
		rect(y+i/(2*k),qu[i], y-i/(2*k), qu[2*k-i+1], col=col[i])
  }
}
# LV box plot
# An extension of standard boxplots which draws k letter statistics
# 
# This is a generic method so please see specific methods for details.
#
# @seealso \code{\link{LVboxplot.formula}}, \code{\link{LVboxplot.numeric}}
# @keyword internal
LVboxplot <- function(x, ...) UseMethod("LVboxplot",x)

# Side-by-side LV boxplots
# An extension of standard boxplots which draws k letter statistics
# 
# Conventional boxplots (Tukey 1977) are useful displays for conveying rough information
# about the central 50\% of the data and the extent of the data.
# 
# For moderate-sized data sets ($n < 1000$), detailed estimates of tail behavior beyond
# the quartiles may not be trustworthy, so the information provided by boxplots is
# appropriately somewhat vague beyond the quartiles, and the expected number of
# ``outliers'' and ``far-out'' values for a Gaussian sample of size $n$ is often less
# than 10 (Hoaglin, Iglewicz, and Tukey 1986). Large data sets ($n \approx
# 10,000-100,000$) afford more precise estimates of quantiles in the tails beyond the
# quartiles and also can be expected to present a large number of ``outliers'' (about 0.4
# + 0.007$n$).
# 
# The letter-value box plot addresses both these shortcomings: it conveys more detailed
# information in the tails using letter values, only out to the depths where the letter
# values are reliable estimates of their corresponding quantiles (corresponding to tail
# areas of roughly $2^{-i}$); ``outliers'' are defined as a function of the most extreme
# letter value shown. All aspects shown on the letter-value boxplot are actual
# observations, thus remaining faithful to the principles that governed Tukey's original
# boxplot.
# 
# @arguments the formula has to be of the form $y \tilde x$, where $x$ is a qualitative variable. The values of $y$ will be split into groups according to their values on $x$ and separate letter value box plots of $y$ are drawn side by side in the same display.
# @arguments significance level, if neither \code{k} nor \code{perc} is specified, \code{alpha} is used to determine how many letter values are to be used.
# @arguments percentage of data points to be shown individually (as outliers) outside the letter-value boxes. \code{perc} is only used, if \code{k} is not specified.  If used, $k$ is determined in such a way, that confidence intervals around each letter value statistics will not include neighboring letter value statistics at a significance level of \code{alpha}.
# @arguments number of letter statistics to compute and draw
# @arguments if defined, aim for \code{perc} percent outliers
# @arguments display horizontally (TRUE) or vertically (FALSE)
# @arguments specify base colour to use
# @arguments unused
# @keyword hplot
# @seealso \code{\link{LVboxplot.numeric}}
#X n <- 10
#X oldpar <- par()
#X par(mfrow=c(4,2), mar=c(3,3,3,3))
#X for (i in 1:4) {
#X 	x <- rexp(n*10^i)
#X 	boxplot(x,col="grey", horizontal=TRUE)
#X 	title(paste("Exponential, n=",length(x)))
#X 	LVboxplot(x,col="grey", xlab="")
#X }
LVboxplot.formula <- function(formula,alpha=0.95, k=NULL, perc=NULL,horizontal=TRUE,col="grey",...) {
    deparen <- function(expr) {
        while (is.language(expr) && !is.name(expr) && deparse(expr[[1]]) == 
            "(") expr <- expr[[2]]
        expr
    }
    bad.formula <- function() stop("invalid formula; use format y ~ x")
    bad.lengths <- function() stop("incompatible variable lengths")
    
    formula <- deparen(formula)
    if (!inherits(formula, "formula")) 
        bad.formula()
    z <- deparen(formula[[2]])
    x <- deparen(formula[[3]])
    rhs <- deparen(formula[[3]])
    if (is.language(rhs) && !is.name(rhs) && (deparse(rhs[[1]]) == 
        "*" || deparse(rhs[[1]]) == "+")) {
        bad.formula()
    }
    z.name <- deparse(z)
    z <- eval(z,  parent.frame())
    x.name <- deparse(x)
    x <- eval(x,  parent.frame())
	setx <- sort(unique(x))
    src.k <- k 
    src.col <- col 


    pt <- 1
	if (horizontal) {
	  plot(z,rep(pt,length(z)),ylim=c(0.5,length(setx)+.5),ylab="",axes=FALSE,type="n",...)
	  box()
	  axis(1)
	  axis(2,at=1:length(setx),labels=as.character(setx))
	} else {
	  plot(rep(pt,length(z)),z,xlim=c(0.5,length(setx))+0.5, xlab="", axes=FALSE, type="n", ...)
	  box()
	  axis(2)
	  axis(1,at=1:length(setx),labels=as.character(setx))
	}
	
	result <- list(length(setx))
    for (i in setx) {
       xx <- z[x==i]
	   n <- length(xx)
	   k <- determineDepth(n,src.k,alpha,perc) 

	   if (! is.na(src.col)) { 
	   		#col <- c(brewer.pal(k-1,"Blues"),"Black") # break dependency of ColorBrewer package
	   		
	   		colrgb <- col2rgb(src.col)
	   		colhsv <- rgb2hsv(colrgb)
			if (colhsv[2,1] == 0) {
	   			val <- seq(0.9,colhsv[3,1], length.out=k)
	   			colrgb <- col2rgb(hsv(colhsv[1,1], colhsv[2,1], val))
			} else {
	   			sat <- seq(0.1,colhsv[2,1], length.out=k)
	   			colrgb <- col2rgb(hsv(colhsv[1,1], sat, colhsv[3,1]))
			}
	   		col <- rgb(colrgb[1,],colrgb[2,],colrgb[3,], maxColorValue=255) 	
	   	}
	   else { col <- rep("grey",k) }
	   
	 # compute letter values based on depth  
	   depth    <- rep(0,k)
	   depth[1] <- (1 + n)/2
	   if (k > 1) {
		 for (j in 2:k) {depth[j] <- (1 + floor(depth[j-1]))/2 } 
	   }
	   
	   y <- sort(xx)
	   d <- c(rev(depth),n-depth+1)
	   qu <- (y[floor(d)] + y[ceiling(d)])/2 	
		 # floor and ceiling is the same for .0 values
		 # .5 values yield average of two neighbours
	   
	 # determine outliers
	   out <- (xx<qu[1]) | (xx>qu[2*k])            
		  
	   drawLVplot(xx,pt,k,out,qu,horizontal,col,...)
	   result[[pt]] <- outputLVplot(xx,qu,k,out,depth,alpha)      
	   pt <- pt+1
    }
    invisible(as.list(result))
}

# Single LV boxplot
# Produces a single lettervalue boxplot for the specified data.
# 
# @arguments alpha level for significance level: alpha 100\% confidence intervals do not touch neighboring LV statistics
# @arguments number of letter statistics to compute and draw
# @arguments if defined, aim for \code{perc} percent outliers
# @arguments display horizontally (TRUE) or vertically (FALSE)
# @arguments specify base colour to use
# @arguments unused
# @keyword hplot
# @seealso \code{\link{LVboxplot.formula}}
LVboxplot.numeric <- function(x,alpha=0.95, k=NULL, perc=NULL,horizontal=TRUE,col="grey",...) {
# extension of standard boxplots
# draws k letter statistics

  n <- length(x)
  k <- determineDepth(n,k,alpha,perc) 
  src.col <- col 

  if (! is.na(src.col)) { #col <- c(brewer.pal(k-1,"Blues"),"Black") 
 	   		
	   		colrgb <- col2rgb(src.col)
	   		colhsv <- rgb2hsv(colrgb)
			if (colhsv[2,1] == 0) {
	   			val <- seq(0.9,colhsv[3,1], length.out=k)
	   			colrgb <- col2rgb(hsv(colhsv[1,1], colhsv[2,1], val))
			} else {
	   			sat <- seq(0.1,colhsv[2,1], length.out=k)
	   			colrgb <- col2rgb(hsv(colhsv[1,1], sat, colhsv[3,1]))
			}
	   		col <- rgb(colrgb[1,],colrgb[2,],colrgb[3,], maxColorValue=255) 	
  }
  else { col <- rep("grey",k) }
  
# compute letter values based on depth  
  depth    <- rep(0,k)
  depth[1] <- (1 + n)/2
  if (k > 1) {
    for (j in 2:k) {depth[j] <- (1 + floor(depth[j-1]))/2 } 
  }
  
  y <- sort(x)
  d <- c(rev(depth),n-depth+1)
  qu <- (y[floor(d)] + y[ceiling(d)])/2 	
    # floor and ceiling is the same for .0 values
  	# .5 values yield average of two neighbours
  
# determine outliers
  out <- (x<qu[1]) | (x>qu[2*k])               
  if (k < 1) out <- x

  pt <- 0.5
  if (horizontal) {
    plot(x,rep(pt,length(x)),ylim=c(pt-0.5,pt+0.5),ylab="",axes=FALSE,type="n",...)
	box()
	axis(1)
  } else {
	plot(rep(pt,length(x)),x,xlim=c(pt-0.5,pt+0.5), xlab="", axes=FALSE, type="n", ...)
	box()
	axis(2)
  }
     
  drawLVplot(x,pt,k,out,qu,horizontal,col,...)

  result <- outputLVplot(x,qu,k,out,depth,alpha)
  invisible(result)
}
