R/validationPlot.R

In pik-piam/validation: MAgPIE validation library

validationPlot<-function(func,...,historical=NULL,datasources=NULL,years=NULL,xlim=NULL,ylim=NULL,index=FALSE,same_yscale=TRUE,text_size=15,title=NULL,legend_names=NULL,raw_plot=FALSE,raw_legend=FALSE,withTL=FALSE){
  require(ggplot2, quietly = TRUE)
  require(RColorBrewer, quietly = TRUE)
  require(plyr, quietly = TRUE)
  require(gridExtra, quietly = TRUE)
  ####################################################
  #Get the magpie data
  ####################################################
  magpie<-read_all(func=func,...)
  if(length(magpie)==0)stop("Couldn't read magpie output from the gdx file")
  if(length(magpie)==1 & is.null(names(magpie))) names(magpie)<-"MAgPIE"

  ####################################################
  #Determine the aggregation level of the magpie data
  #Could be replaced by .aggrLevel 
  ####################################################
  level<-.aggrLevel(magpie[[1]])
  if(level=="unknown") stop("Unknown aggregation level specified.")
  if(level=="country") stop("country aggregation level not supported.")
  if(level=="cell") stop("Cellular aggregation level not supported.")
  ####################################################
  #Get the external validation data
  ####################################################
  data<-getData(func=func,...,historical=historical,datasources=datasources)
  if(is.null(data)) warning("No external data for comparison found. Only magpie results will be plotted.")
  
  #######################################################
  #Produce the plot
  #######################################################
  if(withTL){
    #get the validatin plot in raw format
    out<-histoPlot(magpie,
                   historical=data[[1]][["data"]][["historical"]],
                   projection=data[[1]][["data"]][["projection"]],
                   years=years,xlim=xlim,ylim=ylim,index=index,same_yscale=same_yscale,text_size=text_size,
                   title=ifelse(is.null(title),gsub("_"," ",names(data)),title),
                   ylab=ifelse(index,paste("index (",gsub("y","",getYears(magpie[[1]])[1])," = 1)",sep="") ,paste(data[[1]][["unit"]],sep=" ",collapse=" ")),
                   legend_names=ifelse(rep(is.null(legend_names),3),yes=c("Model output","Historical data","Other projections"),no=legend_names),
                   raw_plot=TRUE,
                   raw_legend=FALSE
    )
    #add the trafficLight
    out$TL<-trafficLight(func=func,...,datasources=datasources,aggregate=FALSE,ncol=7,text_size=round(text_size/2))
    if(!raw_plot){
      out<-arrangeGrob(out$figure,out$legend,out$TL,ncol=1,heights=c(0.6,0.2,0.2))
    }
    return(out)
  }
  
  out<-histoPlot(magpie,
                 historical=data[[1]][["data"]][["historical"]],
                 projection=data[[1]][["data"]][["projection"]],
                 years=years,xlim=xlim,ylim=ylim,index=index,same_yscale=same_yscale,text_size=text_size,
                 title=ifelse(is.null(title),gsub("_"," ",names(data)),title),
                 ylab=ifelse(index,paste("index (",gsub("y","",getYears(magpie[[1]])[1])," = 1)",sep="") ,paste(data[[1]][["unit"]],sep=" ",collapse=" ")),
                 legend_names=ifelse(rep(is.null(legend_names),3),yes=c("Model output","Historical data","Other projections"),no=legend_names),
                 raw_plot=raw_plot,
                 raw_legend=raw_legend
  )
  return(out)

}