
#' @title Plot aggregate soil color data
#' 
#' @description Generate a plot from summaries generated by `aggregateColor()`.
#'
#' @param x a `list`, results from `aggregateColor()`
#' @param print.label logical, print Munsell color labels inside of rectangles, only if they fit 
#' @param label.font font specification for color labels
#' @param label.cex font size for color labels
#' @param label.orientation label orientation, `v` for vertical or `h` for horizontal
#' @param buffer.pct extra space between labels and color rectangles
#' @param print.n.hz optionally print the number of horizons below Munsell color labels
#' @param rect.border color for rectangle border
#' @param horizontal.borders optionally add horizontal borders between bands of color
#' @param horizontal.border.lwd line width for horizontal borders
#' @param x.axis logical, add a scale and label to x-axis?
#' @param y.axis logical, add group labels to y-axis?
#' @param ... additional arguments passed to `plot`
#'
#' @details See the [related tutorial for additional examples](http://ncss-tech.github.io/AQP/sharpshootR/aggregate-soil-color.html).
#' 
#' @author D.E. Beaudette
#'
#' @return no data are returned, function is called for graphical output
#' @export
#' 
#' @keywords hplots
#'
#' @examples
#' 
#' # keep examples from using more than 2 cores
#' data.table::setDTthreads(Sys.getenv("OMP_THREAD_LIMIT", unset = 2))
#' 
#' # load some example data
#' data(sp1, package = 'aqp')
#' 
#' # upgrade to SoilProfileCollection and convert Munsell colors
#' sp1$soil_color <- with(sp1, munsell2rgb(hue, value, chroma))
#' depths(sp1) <- id ~ top + bottom
#' site(sp1) <- ~ group
#' 
#' # generalize horizon names
#' n <- c('O', 'A', 'B', 'C')
#' p <- c('O', 'A', 'B', 'C')
#' sp1$genhz <- generalize.hz(sp1$name, n, p)
#' 
#' # aggregate colors over horizon-level attribute: 'genhz'
#' a <- aggregateColor(sp1, groups = 'genhz', col = 'soil_color')
#' 
#' # check results
#' str(a)
#' 
#' # simple visualization
#' aggregateColorPlot(a)
#' 
aggregateColorPlot <- function(x, print.label=TRUE, label.font=1, label.cex=0.65, label.orientation = c('v', 'h'), buffer.pct=0.02, print.n.hz=FALSE, rect.border='black', horizontal.borders=FALSE, horizontal.border.lwd=2, x.axis=TRUE, y.axis=TRUE, ...) {
  
  # sanity check
  label.orientation <- match.arg(label.orientation)
  
  # extract just the scaled data from the results of aggregateColor()
  s.scaled <- x$scaled.data
  
  # get max re-scaled summation for xlim
  max.plot <- max(sapply(s.scaled, function(i) sum(i$weight)))
  
  # setup plot
  plot(1, 1, type = 'n', xlim = c(0, max.plot), ylim = c(length(names(s.scaled))+0.5, 0.5), axes = FALSE, ylab = '', xlab = 'Cumulative Proportion', col.main = par('fg'), col.lab = par('fg'), ...)
  
  # iterate over horizons
  for(i in seq_along(names(s.scaled))) {
    
    # current iteration
    s.i <- s.scaled[[i]]
    n.colors <- nrow(s.i)
    
    if(n.colors > 0) {
      # get an index to the last weight
      last.weight <- length(s.i$weight)
      # compute cumulative left / right rectangle boundaries
      x.left <- cumsum(c(0, s.i$weight[-last.weight]))
      x.right <- c(x.left[-1], x.left[last.weight] + s.i$weight[last.weight])
      
      # plot rectangles from vectorized coordinates / colors
      # first column in each chunk is the R color
      rect(xleft=x.left, ybottom=i-0.5, xright=x.right, ytop=i+0.5, col=s.i[, 1], border=rect.border)
      
      # compute center point for color labels
      centers <- (x.right + x.left) / 2
      
      # create label
      if(print.n.hz) {
        # with number of horizons
        color.labels <- paste0(s.i$munsell, '\n', '(', s.i$n.hz, ')')
      } else {
        # just colors
        color.labels <- s.i$munsell
      }
      
      
      # determine if there is enough room to label colors: some % of visible space on plot
      # first, get the plot aspect ratio
      plot.w <- par("pin")[1]/diff(par("usr")[1:2])
      plot.h <- par("pin")[2]/diff(par("usr")[3:4])
      plot.asp <- abs(plot.w / plot.h)
      
      # determine if label will fit within a reasonable buffer percentage
      if(label.orientation == 'v') {
        # vertical calculation
        
        # get text heights, as we will be printing labels at 90 deg
        text.heights <- abs(strheight(color.labels, cex = label.cex, font = label.font))
        # convert text heights into equivalent widths
        text.heights <- text.heights / plot.asp
        # compare re-scaled text heights with rectangle widths (weights) + some buffer
        label.fits <- which(text.heights < (s.i$weight - buffer.pct) )
        
      } else {
        # horizontal calculation
        
        # get text heights, as we will be printing labels at 90 deg
        text.widths <- abs(strwidth(color.labels, cex = label.cex, font = label.font))
        
        # compare re-scaled text widths with rectangle widths (weights) + some buffer
        label.fits <- which(text.widths < (s.i$weight - buffer.pct) )
      }
      
      
      # print labels
      if(print.label & (length(label.fits) > 0)) {
        
        # adjust label color based on background
        # from aqp
        label.col <- invertLabelColor(s.i[, 1])
        
        # adjust label angle based argument
        label.srt <- switch(label.orientation, v = 90, h = 0)
        
        text(
          x = centers[label.fits], 
          y = i, 
          labels = color.labels[label.fits], 
          col = label.col[label.fits], 
          font = label.font, 
          cex = label.cex, 
          srt = label.srt
        )
      }
      
    }
  }
  
  # add horizontal separator lines, typically used when rectange borders are not drawn
  if(horizontal.borders){
    hz.line.y <- 1:(length(names(s.scaled))-1) + 0.5
    segments(x0 = 0, y0 = hz.line.y, x1 = 1, y1 = hz.line.y, lwd=horizontal.border.lwd)
  }
  
  # label x-axis with a scale
  if(x.axis) {
    axis(1, at=round(seq(0, 1, length.out = 11), 2), col=par('fg'), col.axis=par('fg'))
  }
  
  
  # label x-axis with group names
  if(y.axis) {
    axis(2, at = seq_along(names(s.scaled)), labels = names(s.scaled), las=2, tick=FALSE, font=2, hadj=1, line=-2.125, cex.axis=1, col=par('fg'), col.axis=par('fg'))
  }
  
}
