R/add_aggrType.R

In pik-piam/validation: MAgPIE validation library

add_aggrType<-function(name,func,overwrite=FALSE,internal=FALSE,svn_path="http://subversion/svn/magpie/libraries/"){
  
  ###################################################################
  #Download the library if requested
  ###################################################################
  if(!internal){
    dirname<-.loadData(svn_path=svn_path)
  }
  ###################################################################
  #Determine if func takes any arguments in addition to x,
  #the quantity to be aggregated
  ###################################################################
  additional_arguments<-names(formals(func))
  additional_arguments<-additional_arguments[-which(additional_arguments=="x")]
  if(length(additional_arguments)==0) additional_arguments<-NULL
  
  ###################################################################
  #Check if the function is already present in the aggr_types list
  #If everything is alright, add it.
  ###################################################################
  
  libentry<-valdata$aggr_types[[name]]
  func_present<-any(unlist(lapply(valdata$aggr_types,identical,func)))
  if(func_present){
    tmp<-unlist(lapply(valdata$aggr_types,identical,func))
    libname<-names(tmp)[which(tmp==TRUE)]
    warning("The aggregation function you want to add is alredy present under the name ",libname,".\nNo action is performed!")
    system(paste("rm -rf",fullpath))
    return(1)
  } else{
    if(!is.null(libentry)){
      if(!overwrite) {
        warning("Some other aggregation function is already stored under the name '", name,"'.\nIf you want to overwrite it, use the overwrite =TRUE argument.")
        return(1)
      } else {
        valdata$aggr_types[[name]]<-list()
        valdata$aggr_types[[name]][["func"]]<-func
        valdata$aggr_types[[name]][["add_args"]]<-additional_arguments
      }
    } else{
      valdata$aggr_types[[name]]<-list()
      valdata$aggr_types[[name]][["func"]]<-func
      valdata$aggr_types[[name]][["add_args"]]<-additional_arguments
    }      
  }
  
  ###################################################################
  #Save the updated valdata object, build the library with the updated valdata.rda and commit it
  ###################################################################
  if(!internal){
    save(valdata,file=path(dirname,"validation/data/valdata.rda"))
    tmp<-try(buildLibrary(lib="validation",libpath=dirname,svn_path=svn_path))
    if(is(tmp,"try-error")){
      .cleanDownload(libdir=dirname,workdir=thisdir)
      stop()
    }
    tmp<-.commitLibrary(libdir=dirname,message=paste('"Added validation data for',data_name,' from the source',name,'to validation library"'))
    if(tmp!=0){
      .cleanDownload(libdir=dirname,workdir=thisdir)
      stop("Problems comitting the updated library")
    }
    .cleanDownload(libdir=dirname,workdir=thisdir)
    cat("Data successfully added")
  } else {
    assign("valdata",valdata,pos=sys.frame(sys.parent(n=1)))
  }
}