CAMP_RST: CAMP RST R Routines

#' @export
#' 
#' @title F.plot.lifestages
#'   
#' @description Produce a plot of the passage associated with all distinct 
#'   combinations of lifestage (or fork length) and run.
#'   
#' @param  df A data frame containing runs in the rows and life stages (or 
#'   fork-length groups) across the columns.
#'   
#' @param  file.root A text string indicating a prefix to append to all output.
#'   
#' @param  plot.pies If \code{TRUE}, a pie chart is produced instead of a bar 
#'   chart.
#'   
#' @details Function \code{F.plot.lifestages} works on both life stages and 
#'   fork-length groups, depending on if \code{F.run.passage} or 
#'   \code{passageWithLifeStageAssign} was called in the case of the former, or 
#'   if \code{F.lifestage.passage.forkLength} in the case of the latter.
#'   
#'   Note that function \code{F.lifestage.passage.forkLength} only plots results
#'   from the Fall run, by design.
#'   
#' @return A graphical \code{png} plotting a bar chart showing relative numbers 
#'   of estimated passage, with lifestages down the rows, and runs across the 
#'   columns.  Generally, all passage routines utilize the bar-chart option via 
#'   paramter \code{plot.pies};  thus, pie charts are never returned.
#'   
#' @author WEST Inc.
#'   
#' @seealso \code{F.run.passage}, \code{passageWithLifeStageAssign}, 
#'   \code{F.lifestage.passage.forkLength}
#'   
#' @examples
#' \dontrun{
#' # Plot passage estimates housed in a data frame
#' # entitled allCatch.  
#' F.plot.lifestages(df=allCatch,file.root="PassageResults",plot.pies=FALSE)
#' }
F.plot.lifestages <- function( df, file.root, plot.pies=FALSE ){

  # df <- df
  # file.root <- output.file
  # plot.pies <- F
  
  #   ---- Get passage columns and totals row indices.
  pass.cols <- grep( "passage", names(df) )
  tot.row <- grep( "Total", df$LifeStage )
  
  #   ---- Get totals.
  tots <- df[ tot.row, pass.cols ]
  
  #   ---- Pare down the data frame to just passage columns, no totals.
  df2 <- df[ -tot.row, pass.cols, drop=F ]
  
  #   ---- Drop the runs with 0 fish. 
  df2 <- df2[ , tots > 0, drop=F ]
  
  #   ---- Drop the lifestages with no fish.
  tots <- apply( df2, 1, sum )
  df2 <- df2[ tots > 0, , drop=F]
  
  #   ---- Make sure we actually have at least one fish somewhere. 
  if( nrow(df2) == 0 ){
    cat("F.plot.lifestages - ALL ZEROS\n")
    return("ZEROS")    
  }
  
  #   ---- Reorder the columns to make the bar charts go through time.
  run.names <- strsplit(names(df2), ".", fixed=T)
  run.names <- unlist(lapply( run.names, function(x){x[1]} ))
  run.names.order <- factor( run.names, levels=c("Fall", "Late fall", "Winter", "Spring", "Summer", "Mixed") )
  run.names.order <- order( as.numeric( run.names.order ))
  df2 <- df2[ , run.names.order, drop=F ]
  run.names <- run.names[ run.names.order ]
  
  #   ---- Reorder the rows so life stages increase from left to right.
  ls.names <- rownames(df2)
  ls.names[ ls.names == "YOY (young of the year)" ] <- "YOY"
  ls.names[ ls.names == "Unassigned" ] <- "Missing"
  ls.names.order <- factor( ls.names, levels=c("YOY", "Fry", "Parr", "Smolt", "Yearling", "Juvenile", "Adult", "Mixed", "Other") )  
  ls.names.order <- order( as.numeric( ls.names.order ))  # Any NA's go at the end.
  df2 <- df2[ ls.names.order, , drop=F]
  ls.names <- ls.names[ ls.names.order ]
  
  
  #   ---- Do the plot.
  if( plot.pies ){
  
    file.list <- NULL
    for( j in 1:ncol(df2) ){
  
      #   ---- If file=NA, a pdf graphing device is assumed to be open already.
      if( !is.na(file.root) ){
        
        #   ---- Shut down all graphics devices.
        graphics.off()
          
        #   ---- Open PNG device.
        out.pass.graphs <- paste(file.root, "_", run.names[j], ".png", sep="")
        if(file.exists(out.pass.graphs)){
          file.remove(out.pass.graphs)
        }
        
        #   ---- Produces hi-resolution graphs unless there's an error.  Then, it 
        #   ---- uses default png settings.
        tryCatch({png(filename=out.pass.graphs,width=7,height=7,units="in",res=600)}, error=function(x){png(filename=out.pass.graphs)}) 
          file.list <- c(file.list, out.pass.graphs)
      }
  
      #   ---- Set graphical parameters, calculate percentages, and then make
      #   ---- the pie chart.  
      y <- df2[,j]
      y <- y / sum(y)
      gt0 <- y > 0
      y <- y[gt0]
      labs <- ls.names[gt0]
  
      pie( y, labs, main=run.names[j] )
      
      #   ---- Output the png.
      if( !is.na(file.root) ){
        dev.off(dev.cur())
      }
    }
  } else {
    
    #   ---- If file=NA, a pdf graphing device is assumed to be open already.
    file.list <- NULL
    if( !is.na(file.root) ){
      
      #   ---- Shut down all graphics devices.
      graphics.off()
        
      #   ---- Open PNG device.
      out.pass.graphs <- paste(file.root, "_lifestage_barchart.png", sep="")
      if(file.exists(out.pass.graphs)){
         file.remove(out.pass.graphs)
      }
      #   ---- Produces hi-resolution graphs unless there's an error;  then, it
      #   ---- uses default png settings.
      tryCatch({png(filename=out.pass.graphs,width=7,height=7,units="in",res=600)}, error=function(x){png(filename=out.pass.graphs)}) 
      file.list <- c(file.list, out.pass.graphs)
    }

    #   ---- Set up the plot parameters.  
    n.plots <- ncol(df2)
    
    layout.mat <- matrix(1,n.plots+1,2)
    layout.wid <- c(1,20)
    layout.hgt <- c(rep(12/n.plots,n.plots),3)   
    layout.mat[,2]<-2:(n.plots+2)
    layout(layout.mat, widths=layout.wid, heights=layout.hgt)

    #   ---- Place y-axis label in margin.
    par(mar=c(0,0,0,0))
    plot(c(0,1),c(0,1),type="n",xlab="",ylab="",xaxt="n",yaxt="n", bty="n")
    text(.65,.55,"Proportion of Catch", cex=2, srt=90)
         
    #   ---- Make the bars in the bar plot.  
    for( j in 1:n.plots ){
      y <- df2[,j]
      y <- y / sum(y)
      par(mar=c(0,4.1,1.5,2.1))

      tmp<-barplot( y, ylim=c(0,1.35), xaxt="n", col="orange", yaxt="n" )
      
      #   ---- Special consideration if there's only one bar.  
      if(nrow(tmp) == 1){  
        axis( 2, at=c(0,.25,.5,.75,1) )
        text( 1.7*max(tmp), 1.15, run.names[j], adj=1, cex=2)
      } else {
        axis( 2, at=c(0,.25,.5,.75,1) )
        text( max(tmp)+.4*(tmp[2]-tmp[1]), 1.15, run.names[j], adj=1, cex=2)
      }

      n <- formatC(round(df2[1,j]),big.mark=",",digits=8)
      n <- gsub(" ", "", n)
      axis( 1, at=tmp[1], labels=paste("n=",n,sep=""), tick=F, line=-1 )
      if ( length(tmp) > 1){
        for( i in 2:length(tmp) ){  
          n <- formatC(round(df2[i,j]),big.mark=",",digits=8)
          n <- gsub(" ", "", n)
          axis( 1, at=tmp[i], labels=n, tick=F, line=-1 )
        }
      }
    }
        
    #   ---- Write out the lifestage names along the bottom.
    par(mar=c(0,4.1,1,2.1))
    tmp<-barplot( y, ylim=c(0,1), xaxt="n", yaxt="n", col=0, border=0 )
    for( j in 1:length(tmp)){
      text( tmp[j], .95, ls.names[j], srt=90, adj=1, cex=1.75 )
    }

    #   ---- Output the png.  
    if( !is.na(file.root) ){
      dev.off(dev.cur())
    }
  }
file.list
}