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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.