R/getData.R

In pik-piam/validation: MAgPIE validation library

getData<-function(func,...,historical=NULL,datasources=NULL){
  #################################################################
  #Get a GDX file for expand.set
  #################################################################
  gdx<-list(...)[["gdx"]]
  if(is.null(gdx)) stop("gdx file has to be specified")
  if(!is.list(gdx))gdx<-as.list(gdx)
  if(identical(names(gdx),c("aliases","sets","equations","parameters","variables"))) gdx<-list(gdx)
  gdx<-gdx[[1]]

  ###############################################################
  #Check whether data for that identifier exists in the library
  ###############################################################
  identifier<-.getIdentifier(func,...,get=TRUE)

  matches<-names(unlist(lapply(mapping,grep,pattern=identifier)))

  if(length(matches)==0){
    warning("No data found. NULL returned.")
    return(NULL)
  }

  ###############################################################
  #Determine the requested aggregation level
  ###############################################################
  arguments<-.getIdentifier(func,...,get=TRUE,return_arguments=TRUE)

  func_level<-arguments[["level"]]
  if(func_level=="reg"){
    query <- readGDX(gdx,"i_to_iso",react = "silent")
    if(!is.null(query)) names(query) <- c("reg","iso")
  } else {
    query <- NULL
  }
  
  ###############################################################
  #get the data
  ###############################################################
  out<-getData_raw(collections=matches,level=func_level,historical=historical,datasources=datasources,query=query)
  
  ###############################################################
  #Determine if any of the arguments have to be chosen
  ###############################################################
  chooselist<-list()
  for(i in 1:length(matches)){
    tmp<-grep(identifier,mapping[[matches[i]]],value=TRUE)
    tmp<-gsub(pattern="^.*\\(",replacement="",tmp)
    tmp<-gsub(pattern="\\)$",replacement="",tmp)
    tmp<-strsplit(tmp,split=",")[[1]]
    tmp<-grep(".*##CHOOSE##",tmp,value=T)
    tmp<-gsub("=##CHOOSE##","",tmp)
    if(length(tmp)>0) {
      #This is ugly: The set that has been provided for an argument that can be chosen has to be expanded. We do not know however
      #which set is the fullset. Therefore, all common high level sets are tested and the expanded set with the greatest length is chosen.
      allsets<-names(readGDX(gdx,types="sets"))
      expandedsets<-list()
      for(j in allsets){
        expandedsets[[j]]<-suppressWarnings(expand.set(gdx,arguments[[tmp]],j))
      }
      lengthexpandedsets<-unlist(lapply(expandedsets,length))
      if(max(lengthexpandedsets)==0) stop("Bad argument value specified for the argument '",tmp,"': ",arguments[[tmp]])
      j<-names(lengthexpandedsets)[which(lengthexpandedsets==max(lengthexpandedsets))[1]]
      chooselist[[matches[i]]]<-expandedsets[[j]]
    }
  }
  tmpfunc<-function(x,args,sum=FALSE){
    if(length(args)==0) return(x)
    out<-x
    out<-out[,,args]
    if(sum){
      out<-dimSums(out,dim=3.2)
    }
    return(out)
  }
  sum<-FALSE
  if("sum" %in% names(arguments)) sum<-arguments[["sum"]]
  for(i in matches){
    for(hist in c("historical","projection")){
      if(!is.null(out[[i]][["data"]][[hist]])){
        out[[i]][["data"]][[hist]]<-lapply(out[[i]][["data"]][[hist]],FUN=tmpfunc,args=chooselist[[i]],sum=sum)
      }
    }
  }
  
  return(out)
}