plot_OutputsModel.R

#*****************************************************************************************************************
#' Function which creates a screen plot giving an overview of the model outputs
#'
#' Dashboard of results including various graphs (depending on the model):
#' (1) time series of total precipitation and simulated flows (and observed flows if provided)
#' (2) interannual median monthly simulated flow (and observed flows if provided)
#' (3) correlation plot between simulated and observed flows (if observed flows provided)
#' (4) cumulative frequency plot for simulated flows (and observed flows if provided)
#*****************************************************************************************************************
#' @title   Default preview of model outputs
#' @author  Laurent Coron (June 2014)
## @example tests/example_plot_OutputsModel.R
#' @encoding UTF-8
#' @export
#_FunctionInputs__________________________________________________________________________________________________
#' @param  OutputsModel      [object of class \emph{OutputsModel}] list of model outputs (which must at least include DatesR, Precip and Qsim) [POSIXlt, mm, mm]
#' @param  Qobs              (optional) [numeric] time series of observed flow (for the same time-steps than simulated) [mm]
#' @param  IndPeriod_Plot    (optional) [numeric] indices of the time-steps to be plotted (among the OutputsModel series)
#' @param  BasinArea         (optional) [numeric] basin area [km2], used to plot flow axes in m3/s
#' @param  PlotChoice        (optional) [character] choice of plots \cr (e.g. c("Precip","SnowPack","Flows","Regime","CumFreq","CorQQ")), default="all"
#' @param  quiet             (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE
#_FunctionOutputs_________________________________________________________________________________________________
#' @return  screen plot window
#*****************************************************************************************************************
plot_OutputsModel <- function(OutputsModel,Qobs=NULL,IndPeriod_Plot=NULL,BasinArea=NULL,PlotChoice="all",quiet=FALSE){


  if(!inherits(OutputsModel,"GR") & !inherits(OutputsModel,"CemaNeige")){ stop(paste("OutputsModel not in the correct format for default plotting \n",sep="")); return(NULL); }

  BOOL_Dates <- FALSE; 
      if("DatesR" %in% names(OutputsModel)){ BOOL_Dates <- TRUE; }
  BOOL_Pobs <- FALSE; 
      if("Precip" %in% names(OutputsModel)){ BOOL_Pobs <- TRUE; }
  BOOL_Qsim <- FALSE; 
      if("Qsim"   %in% names(OutputsModel)){ BOOL_Qsim <- TRUE; }
  BOOL_Qobs <- FALSE;
      if(BOOL_Qsim & length(Qobs)==length(OutputsModel$Qsim)){ if(sum(is.na(Qobs))!=length(Qobs)){ BOOL_Qobs <- TRUE; } }
  BOOL_Snow <- FALSE;
      if("CemaNeigeLayers" %in% names(OutputsModel)){ if("SnowPack" %in% names(OutputsModel$CemaNeigeLayers[[1]])){ BOOL_Snow <- TRUE; } }
  BOOL_Psol <- FALSE;
      if("CemaNeigeLayers" %in% names(OutputsModel)){ if("Psol"     %in% names(OutputsModel$CemaNeigeLayers[[1]])){ BOOL_Psol <- TRUE; } }


  if( is.null(     PlotChoice)){ stop("PlotChoice must be a vector of character \n"); return(NULL); } 
  if(!is.vector(   PlotChoice)){ stop("PlotChoice must be a vector of character \n"); return(NULL); } 
  if(!is.character(PlotChoice)){ stop("PlotChoice must be a vector of character \n"); return(NULL); } 
  if(sum(PlotChoice %in% c("all","Precip","SnowPack","Flows","Regime","CumFreq","CorQQ")==FALSE)!=0){
    cat("Incorrect element found in PlotChoice \n");
    stop("PlotChoice can only contain 'all', 'Precip', 'SnowPack', 'Flows', 'Regime', 'CumFreq' or 'CorQQ') \n");
    return(NULL); } 
  if("all" %in% PlotChoice){ PlotChoice <- c("Precip","SnowPack","Flows","Regime","CumFreq","CorQQ"); }

  if(!BOOL_Dates){
    stop(paste("OutputsModel must contain at least DatesR to allow plotting \n",sep="")); return(NULL); }
  if(inherits(OutputsModel,"GR") & !BOOL_Qsim){
    stop(paste("OutputsModel must contain at least Qsim to allow plotting \n",sep="")); return(NULL); }

  if(BOOL_Dates){
    MyRollMean1 <- function(x,n){
      return(filter(x,rep(1/n,n),sides=2)); }
    MyRollMean2 <- function(x,n){
      return(filter(c(tail(x,n%/%2),x,x[1:(n%/%2)]),rep(1/n,n),sides=2)[(n%/%2+1):(length(x)+n%/%2)]); }
    BOOL_TS  <- FALSE;
    TimeStep <- difftime(tail(OutputsModel$DatesR,1),tail(OutputsModel$DatesR,2),units="secs")[[1]];
    if(inherits(OutputsModel,"hourly" ) & TimeStep %in% (                  60*60)){ BOOL_TS <- TRUE; NameTS <- "hour" ; plotunit <- "[mm/h]";     formatAxis <- "%m/%Y"; }
    if(inherits(OutputsModel,"daily"  ) & TimeStep %in% (               24*60*60)){ BOOL_TS <- TRUE; NameTS <- "day"  ; plotunit <- "[mm/d]";     formatAxis <- "%m/%Y"; }
    if(inherits(OutputsModel,"monthly") & TimeStep %in% (c(28,29,30,31)*24*60*60)){ BOOL_TS <- TRUE; NameTS <- "month"; plotunit <- "[mm/month]"; formatAxis <- "%m/%Y"; }
    if(inherits(OutputsModel,"yearly" ) & TimeStep %in% (    c(365,366)*24*60*60)){ BOOL_TS <- TRUE; NameTS <- "year" ; plotunit <- "[mm/y]";     formatAxis <- "%Y"   ; }
    if(!BOOL_TS){ stop(paste("the time step of the model inputs could not be found \n",sep="")); return(NULL); } 
  }