R/addData_raw.R

In pik-piam/validation: MAgPIE validation library

addData_raw<-function(data,aggr_type,aggr_args=NULL,collection,name,historical=TRUE,unit=NULL,citation=NULL,comment=NULL,overwrite=FALSE,internal=FALSE,svn_path=NULL){
  thisdir<-getwd()
  if(!is.magpie(data)) stop("Data has to be provided as a magpie object!")
  if(length(grep(" ",name))>0) stop("Name must not contain spaces.")
  if(length(grep(" ",collection))>0) stop("Collection must not contain spaces.")
  ###################################################################
  #Check whether the third dimension of data has the correct structure
  ###################################################################
  expandedData<-unwrap(data)
  dims<-length(dim(expandedData))
  tmpfunc<-function(x){
    return(all(x %in% c("data","up","lo")))
  }
  datadim<-lapply(dimnames(expandedData),tmpfunc)
  datadim<-which(unlist(datadim))
  
  if(length(datadim)!=0){
    if(all(dimnames(expandedData)[[datadim]]=="data") || 
         all(c("data","lo","up")%in%dimnames(expandedData)[[datadim]])){
      tmp<-(1:length(dim(expandedData)))[which(!(1:length(dim(expandedData)))%in%c(1,2,datadim))]
      if(length(tmp)==0){
        data<-as.magpie(wrap(expandedData,map=list(1,2,3)))
      } else {
        data<-as.magpie(wrap(expandedData,map=list(1,2,c(datadim,tmp))))
      }
    } else {
      stop("Data format not supported. See help for details.")
    }
  } else {
    if(is.null(getNames(data))){
      getNames(data)<-"data"
    } else {
      getNames(data)<-paste("data",getNames(data),sep=".")
    }
  }

  ###################################################################
  #Determine the aggregation level of the data
  ###################################################################
  data_level<-.aggrLevel(data)
  if(data_level=="unknown") stop("Unknown aggregation level of data.")
  if(data_level=="reg") stop("Regional data cannot be added.")

  ###################################################################
  #Download the library if requested
  ###################################################################
  if(!internal){
    dirname<-.loadData(svn_path=svn_path)
  }
  ###################################################################
  #Set the correct type name for the 'historical' flag
  ###################################################################
  if(historical){
    type<-"historical"
  } else{
    type<-"projection"
  }
  
  ###################################################################
  #Add the comment if specified
  ###################################################################
  if(!is.null(comment))attr(data,"comment")<-comment
  
  
  #################################################################
  #Check whether the aggr_type is supported by the library
  #################################################################
  if(!aggr_type %in% names(valdata$aggr_types)){
    if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
    stop("The specified aggregation type: ",aggr_type," is not supported by the library.\n If you want to add new aggregation routines, use the function add_aggrType")
  }


  #################################################################
  #If there is no entry for the collection yet in the valdata object
  #ask the user for a name of the dataset to store in
  #################################################################
  if(!internal){
    data_name<-.chooseCollection(collections=collection)
    if(data_name=="unknown"){
      .cleanDownload(libdir=dirname,workdir=thisdir)
      stop("Cancelled by user.")
    }
  } else {
    data_name<-collection
  }
  
  ###################################################################
  #Check whether conflicting aggregation types are provided
  ###################################################################
  if(!is.null(valdata$data[[data_name]])){
    if(!valdata$data[[data_name]][["aggr_type"]]==aggr_type){
      if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
      stop("Conflicting aggr_types. Library: ",valdata$data[[data_name]][["aggr_type"]]," , function call: ",aggr_type,".")
    }
  }
  
  ###################################################################
  #Check whether conflicting units are provided
  ###################################################################
  if(is.null(valdata[["data"]][[data_name]])){
    if(is.null(unit)){
      if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
      stop("A unit has to be specified")
    }
  } else {
    if(!is.null(unit) & any(valdata[["data"]][[data_name]][["unit"]]!=unit)){
      if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
      stop("Mismatch in units. Library: ",valdata[["data"]][[data_name]][["unit"]]," addData: ",unit)
    }
  }
  
  ###################################################################
  #Add the data to valdata including the aggregation type and potential additional aruments for the aggregation
  ###################################################################
  if(is.null(valdata[["data"]][[data_name]])){
    valdata[["data"]][[data_name]]<-list()
    valdata[["data"]][[data_name]][["aggr_type"]]<-aggr_type
    valdata[["data"]][[data_name]][["unit"]]<-unit
  }
  if(is.null(valdata[["data"]][[data_name]][["data"]][[data_level]])){
    valdata[["data"]][[data_name]][["data"]][[data_level]]<-list()
  }
  if(is.null(valdata[["data"]][[data_name]][["data"]][[data_level]][["data"]][[type]])){
    valdata[["data"]][[data_name]][["data"]][[data_level]][["data"]][[type]]<-list()
  }
  if(!is.null(valdata[["data"]][[data_name]][["data"]][[data_level]][["data"]][[type]][[name]]) && overwrite==FALSE){
    if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
    stop("A dataset named '",name,"' already exists in the collection ",data_name," If you want to overwrite it, use the overwrite = TRUE argument in the add_data call")
  } else{
    valdata[["data"]][[data_name]][["data"]][[data_level]][["data"]][[type]][[name]]<-list()
    valdata[["data"]][[data_name]][["data"]][[data_level]][["data"]][[type]][[name]][["data"]]<-data
    if(!is.null(citation)){
      if(length(grep(".*\\.bib$",citation))==1){
        citation<-suppressWarnings(readLines(citation,encoding="latin1"))
      }
      Encoding(citation)<-"latin1"
      citation<-iconv(citation,"latin1","ASCII",sub="")
      valdata[["data"]][[data_name]][["data"]][[data_level]][["data"]][[type]][[name]][["citation"]]<-citation
    }
    #Add the arguments for agregation
    #Check if all arguments for the aggregation function are specified
    if(!is.null(valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["add_args"]])){
      if(is.null(aggr_args)){
        if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
        stop("The aggregation type you chose requires all of the following additional arguments: ",paste(valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["add_args"]],sep="\n"),".")
      } else if(!intersect(names(aggr_args),valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["add_args"]])==valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["add_args"]]){
        if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
        stop("The aggregation type you chose requires all of the following additional arguments: ",paste(valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["add_args"]],sep="\n"),".")
      } else {
        #Add the aggregation arguments
        for(i in valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["add_args"]]){
          valdata$data[[data_name]][["data"]][[data_level]][["data"]][[type]][[name]][[i]]<-aggr_args[[i]]
        }
      }
    } else if(!is.null(aggr_args)){
      if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
      stop("The aggregation type you chose requires no additional arguments. You however specified some in aggr_args!")
    }
  }

  ###################################################################
  #Check whether the aggregation works for the new data
  ###################################################################
  args<-list(data=valdata$data[[data_name]][["data"]][[data_level]][["data"]][[type]][[name]][["data"]],
             vectorfunction=valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["func"]],
             dim=1,
             to="glo")
  for(i in valdata$aggr_types[[valdata$data[[data_name]][["aggr_type"]]]][["add_args"]]){
    args[[i]]<-valdata$data[[data_name]][["data"]][[data_level]][["data"]][[type]][[name]][[i]]
  }
  test<-try(suppressWarnings(do.call(groupAggregate,args)))
  if(is(test,"try-error")){
    if(!internal).cleanDownload(libdir=dirname,workdir=thisdir)
    stop("Problems occur when aggregating the added data to global level. Data won't be added")
  }

  
  ###################################################################
  #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)))
  }
}