R/addData.R

In pik-piam/validation: MAgPIE validation library

addData<-function(func,...,data,aggr_type,aggr_args=NULL,datasource,historical=TRUE,unit=NULL,citation=NULL,comment=NULL,ignore.args=NULL,choose.args=NULL,overwrite=FALSE,internal=FALSE,svn_path=NULL){
  thisdir<-getwd()
  ###################################################################
  #Determine the aggregation level of the data and compare to the aggregation level of func
  ###################################################################
  data_level<-.aggrLevel(data)
  if(data_level=="unknown") stop("Unknown aggregation level of data.")
  if(data_level=="reg") stop("Regional data cannot be added.")
  func_level<-list(...)[["level"]]
  if(is.null(func_level)) func_level<-formals(func)[["level"]]
  levels<-c("cell","country","reg","glo")
  if(grep(data_level,levels)>grep(func_level,levels)) stop("'data' is more aggregated than the level defined in the 'func' function argument.")

  ###################################################################
  #Download the library and load mapping and valdata objects if requested
  ###################################################################
  if(!internal){
    dirname<-.loadData(svn_path=svn_path)
  }

  ###########################################################################
  #If identifier is not present in the mapping yet, 
  #check if there are similar identifiers that only differ by ##IGNORE## or ##CHOOSE## arguments. 
  ###########################################################################
  identifier<-.chooseIdentifier(func=func,...,ignore.args=ignore.args,choose.args=choose.args)
  #################################################################
  #If there is no entry for identifier in the mapping yet, ask the user for 
  #a name of the dataset to store in
  #################################################################
  matches<-names(unlist(lapply(mapping,grep,pattern=identifier,fixed=TRUE)))
  data_name<-.chooseCollection(collections=matches)
  if(data_name=="unknown"){
    if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
    stop("Cancelled by user.")
  }
  #################################################################
  #Add the new data_name and the corresponding identifier to mapping and the 
  #valdata object if necessary
  #################################################################
  if(is.null(mapping[[data_name]])) mapping[[data_name]]<-list()
  if(!identifier %in% unlist(mapping[[data_name]])){
    mapping[[data_name]][[length(mapping[[data_name]])+1]]<-identifier
  }
  if(is.null(valdata$data[[data_name]])){
    valdata$data[[data_name]]<-list()
  }
  
  ###################################################################
  #Add the dataset to the valdata object
  ###################################################################
  addData_raw(data=data,aggr_type=aggr_type,aggr_args=aggr_args,collection=data_name,name=datasource,historical=historical,unit=unit,citation=citation,comment=comment,overwrite=overwrite,internal=TRUE,svn_path=svn_path)
  ###################################################################
  #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"))
    save(mapping,file=path(dirname,"validation/data/mapping.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',datasource,'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)))
    assign("mapping",mapping,pos=sys.frame(sys.parent(n=1)))
  }
}