R/AreaPlot.r

In einaooka/tea.eo.plots: TEA's plotting functions

#' @title Area Plot
#'
#' @description Plot area plots. For one y variable, use either PlotArea or FillArea. For number of y variables, use PlotStackedArea.
#'
#' @param x An array of x variable.
#' @param y(s) An array or matrix of y variables.
#' @param col(s) An array of color. Its length has to match the number of y variables.
#' @param legend A list of (need, location, cex).
#' @param add A binary.
#'
#' @import RColorBrewer
#'
#' @export PlotArea
#' @export FillArea
#' @export PlotStackedArea
#'
#' @examples
#' niter <- 10
#' df <- data.frame("Date"=rep(seq(as.Date("2010-1-1"), by="month", length.out = 12),niter)
#' , "Iter" = rep(1:niter,each=12), "Y"=rnorm(12*niter,10,2))
#' df <- cast(df, Date ~ Iter, value="Y")
#'
#' PlotArea(df[,1], df[,2], col=green.f(0.5), xlab="x", ylab="y")
#' FillArea(df[,1], df[,2]/2, col=orange.f(1))
#'
#' PlotStackedArea(df[,1], df[,2:5])
#' PlotStackedArea(df[,1], df[,2:3], col=rainbow.f(c(2,8),1))
#' PlotStackedArea(df[,1], df[,2:10], legend=list(need = TRUE, location="topleft", cex=1)
#' , xlab="month", ylab="random variable")


PlotStackedArea <- function(x, ys, cols=c(NA,NA), legend=list(need = FALSE, location="topleft", cex=1), ...){

  # Number of variables
  numYs <- ncol(ys)
  if (is.na(cols[1])) {cols <- RColorBrewer::brewer.pal(numYs,"Spectral")}

  # Total
  y <- apply(ys, 1, sum)
  PlotArea(x, y, col=rev(cols)[1], ...)

  # Each variable
  if (numYs > 2){
    for (i in (numYs-1):2){
      y <- apply(ys[,1:i], 1, sum)
      FillArea(x,y,cols[i])
    }
  }

  # Last variable
  y <- ys[,1]
  FillArea(x,y,rev(cols)[numYs])

  if(legend$need){
    legend(legend$location
           , inset=.05
           , cex=legend$cex
           , rev(colnames(ys))
           , fill=rev(cols)
           , bg="white"
           , border = gray(0.5))
  }
}

#' @describeIn PlotStackedArea
PlotArea <- function(x , y, col, add=FALSE, ylim=c(NA,NA), ...){
  if (is.na(ylim[1])) ylim <- range(0,y)
  if(!add) plot0(x, y, col=rainbow.f(1,0), ylim=ylim, ...)
  polygon(c(x[1],x,tail(x,1)), c(0, y, 0), col=col, border=FALSE)
}

#' @describeIn PlotStackedArea
FillArea <- function(x , y, col){PlotArea(x , y, col, add=TRUE)}