-
Notifications
You must be signed in to change notification settings - Fork 25
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
renormalise and set gitattributes to get rid of CRLF issues
- Loading branch information
1 parent
c46b013
commit 3f24daa
Showing
5 changed files
with
200 additions
and
198 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,2 @@ | ||
| * text=auto | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,87 +1,87 @@ | ||
| #' Converts a report from one model to another | ||
| #' | ||
| #' This function converts the content of a reporting file from one model to | ||
| #' another | ||
| #' | ||
| #' The function converts data based on a region mapping and transformation | ||
| #' rules which are stored in the variable magclassdata which comes with this | ||
| #' library. | ||
| #' | ||
| #' @param rep Report. Either the file name of a mif file or a report already | ||
| #' read in in R. | ||
| #' @param inmodel Model the input comes from. If NULL the script tries to | ||
| #' detect the inmodel automatically. | ||
| #' @param outmodel Model format the data should be converted to. Currently, | ||
| #' "MAgPIE" and "REMIND" are available | ||
| #' @param full Boolean deciding whether only the converted output should be | ||
| #' returned (FALSE) or the new output together with the input (TRUE) | ||
| #' @param as.list if TRUE a list is returned (default), if FALSE it is tried to | ||
| #' merge all information in one MAgPIE object (still under development and | ||
| #' works currently only if the entries for the different models and scenarios | ||
| #' have exactly the same regions and years). | ||
| #' @author Jan Philipp Dietrich | ||
| #' @seealso | ||
| #' \code{\link{read.report}},\code{\link{write.report}},\code{\link{magclassdata}} | ||
| #' @examples | ||
| #' | ||
| #' \dontrun{convert.report("report.mif")} | ||
| #' | ||
| #' @export convert.report | ||
| convert.report <- function(rep,inmodel=NULL,outmodel="MAgPIE",full=FALSE,as.list=TRUE) { | ||
| # Commets would improve the code | ||
| .convert <- function(input,inmodel=NULL,outmodel="MAgPIE",full=FALSE) { | ||
| # load all region mappings available and check wether inmodel and outmodel are available | ||
| map <- magclassdata$map | ||
| if(!(outmodel %in% names(map))) stop("No existing transformation rules for output model \"",outmodel,"\"!",call.=FALSE) | ||
| if(!(inmodel %in% names(map[[outmodel]]))) stop("No existing transformation rules for input model \"",inmodel,"\" in combination with output model \"",outmodel,"\"!",call.=FALSE) | ||
| if(outmodel %in% names(input)) stop("Input already contains data for model \"",outmodel,"\"",call.=FALSE) | ||
| # read regional mapping from inmodel regions to outmodel regions | ||
| map <- map[[outmodel]][[inmodel]] | ||
| if(!inmodel %in% names(input)) stop(paste0("The inmodel ",inmodel," is not available in the names of input: ",names(input))) | ||
| mag <- input[[inmodel]] | ||
| # add "GLO" if present in data | ||
| if("GLO" %in% getRegions(mag)) map$GLO <- "GLO" | ||
| # construct empty outmag object without region names and with variable names that are defined in trans and present in the input data | ||
| outmag <- mag[rep(1,length(map)),,unlist(magclassdata$trans)[unlist(magclassdata$trans) %in% getNames(mag)]] | ||
| outmag[,,] <- NA | ||
| # set regions names to outmodel regions | ||
| dimnames(outmag)[[1]] <- names(map) | ||
| # transfer data | ||
| # map[[reg]] refers to the inmodel region | ||
| # reg refers to the outmodel region | ||
| for(reg in names(map)) { | ||
| #sum | ||
| elem <- getNames(mag)[getNames(mag) %in% magclassdata$trans$sum] | ||
| if(length(elem)>0) if(!is.na(map[[reg]])) suppressWarnings(outmag[reg,,elem] <- colSums(mag[map[[reg]],,elem])) | ||
| #mean | ||
| elem <- getNames(mag)[getNames(mag) %in% magclassdata$trans$mean] | ||
| if(length(elem)>0) if(!is.na(map[[reg]])) suppressWarnings(outmag[reg,,elem] <- colMeans(mag[map[[reg]],,elem])) | ||
| } | ||
| out <- list(); | ||
| if(full) out[[inmodel]]=mag; | ||
| out[[outmodel]]=outmag; | ||
| return(out) | ||
| } | ||
|
|
||
| if(is.character(rep)) rep <- read.report(rep) | ||
| if(is.null(inmodel)) { | ||
| if(length(names(rep[[1]]))==1) inmodel <- names(rep[[1]]) | ||
| else stop("Not clear which model should be used as input!") | ||
| } | ||
|
|
||
| # convert data from inmodel to outmodel | ||
| if(inmodel!=outmodel) { | ||
| rep <- lapply(rep,.convert,inmodel,outmodel,full) | ||
| } | ||
|
|
||
| if(!as.list) { | ||
| for(scenario in names(rep)) { | ||
| for(model in names(rep[[scenario]])) { | ||
| getNames(rep[[scenario]][[model]]) <- paste(scenario,model,getNames(rep[[scenario]][[model]]),sep=".") | ||
| } | ||
| } | ||
| rep <- mbind(unlist(rep,recursive=FALSE)) | ||
| names(dimnames(rep))[3] <- "scenario.model.value" | ||
| } | ||
| return(rep) | ||
| } | ||
| #' Converts a report from one model to another | ||
| #' | ||
| #' This function converts the content of a reporting file from one model to | ||
| #' another | ||
| #' | ||
| #' The function converts data based on a region mapping and transformation | ||
| #' rules which are stored in the variable magclassdata which comes with this | ||
| #' library. | ||
| #' | ||
| #' @param rep Report. Either the file name of a mif file or a report already | ||
| #' read in in R. | ||
| #' @param inmodel Model the input comes from. If NULL the script tries to | ||
| #' detect the inmodel automatically. | ||
| #' @param outmodel Model format the data should be converted to. Currently, | ||
| #' "MAgPIE" and "REMIND" are available | ||
| #' @param full Boolean deciding whether only the converted output should be | ||
| #' returned (FALSE) or the new output together with the input (TRUE) | ||
| #' @param as.list if TRUE a list is returned (default), if FALSE it is tried to | ||
| #' merge all information in one MAgPIE object (still under development and | ||
| #' works currently only if the entries for the different models and scenarios | ||
| #' have exactly the same regions and years). | ||
| #' @author Jan Philipp Dietrich | ||
| #' @seealso | ||
| #' \code{\link{read.report}},\code{\link{write.report}},\code{\link{magclassdata}} | ||
| #' @examples | ||
| #' | ||
| #' \dontrun{convert.report("report.mif")} | ||
| #' | ||
| #' @export convert.report | ||
| convert.report <- function(rep,inmodel=NULL,outmodel="MAgPIE",full=FALSE,as.list=TRUE) { | ||
| # Commets would improve the code | ||
| .convert <- function(input,inmodel=NULL,outmodel="MAgPIE",full=FALSE) { | ||
| # load all region mappings available and check wether inmodel and outmodel are available | ||
| map <- magclassdata$map | ||
| if(!(outmodel %in% names(map))) stop("No existing transformation rules for output model \"",outmodel,"\"!",call.=FALSE) | ||
| if(!(inmodel %in% names(map[[outmodel]]))) stop("No existing transformation rules for input model \"",inmodel,"\" in combination with output model \"",outmodel,"\"!",call.=FALSE) | ||
| if(outmodel %in% names(input)) stop("Input already contains data for model \"",outmodel,"\"",call.=FALSE) | ||
| # read regional mapping from inmodel regions to outmodel regions | ||
| map <- map[[outmodel]][[inmodel]] | ||
| if(!inmodel %in% names(input)) stop(paste0("The inmodel ",inmodel," is not available in the names of input: ",names(input))) | ||
| mag <- input[[inmodel]] | ||
| # add "GLO" if present in data | ||
| if("GLO" %in% getRegions(mag)) map$GLO <- "GLO" | ||
| # construct empty outmag object without region names and with variable names that are defined in trans and present in the input data | ||
| outmag <- mag[rep(1,length(map)),,unlist(magclassdata$trans)[unlist(magclassdata$trans) %in% getNames(mag)]] | ||
| outmag[,,] <- NA | ||
| # set regions names to outmodel regions | ||
| dimnames(outmag)[[1]] <- names(map) | ||
| # transfer data | ||
| # map[[reg]] refers to the inmodel region | ||
| # reg refers to the outmodel region | ||
| for(reg in names(map)) { | ||
| #sum | ||
| elem <- getNames(mag)[getNames(mag) %in% magclassdata$trans$sum] | ||
| if(length(elem)>0) if(!is.na(map[[reg]])) suppressWarnings(outmag[reg,,elem] <- colSums(mag[map[[reg]],,elem])) | ||
| #mean | ||
| elem <- getNames(mag)[getNames(mag) %in% magclassdata$trans$mean] | ||
| if(length(elem)>0) if(!is.na(map[[reg]])) suppressWarnings(outmag[reg,,elem] <- colMeans(mag[map[[reg]],,elem])) | ||
| } | ||
| out <- list(); | ||
| if(full) out[[inmodel]]=mag; | ||
| out[[outmodel]]=outmag; | ||
| return(out) | ||
| } | ||
|
|
||
| if(is.character(rep)) rep <- read.report(rep) | ||
| if(is.null(inmodel)) { | ||
| if(length(names(rep[[1]]))==1) inmodel <- names(rep[[1]]) | ||
| else stop("Not clear which model should be used as input!") | ||
| } | ||
|
|
||
| # convert data from inmodel to outmodel | ||
| if(inmodel!=outmodel) { | ||
| rep <- lapply(rep,.convert,inmodel,outmodel,full) | ||
| } | ||
|
|
||
| if(!as.list) { | ||
| for(scenario in names(rep)) { | ||
| for(model in names(rep[[scenario]])) { | ||
| getNames(rep[[scenario]][[model]]) <- paste(scenario,model,getNames(rep[[scenario]][[model]]),sep=".") | ||
| } | ||
| } | ||
| rep <- mbind(unlist(rep,recursive=FALSE)) | ||
| names(dimnames(rep))[3] <- "scenario.model.value" | ||
| } | ||
| return(rep) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,68 +1,68 @@ | ||
| #' dimCode | ||
| #' | ||
| #' Function converts a dimension name or number to a dimension Code used for | ||
| #' MAgPIE objects | ||
| #' | ||
| #' | ||
| #' @param dim A vector of dimension numbers or dimension names which should be | ||
| #' translated | ||
| #' @param x MAgPIE object in which the dimensions should be searched for. | ||
| #' @param missing Either a value to which a dimension should be set in case | ||
| #' that it is not found (default is 0), or "stop" indicating that the function | ||
| #' should throw an error in these cases. | ||
| #' @param sep A character separating joined dimension names | ||
| #' @return A dimension code identifying the dimension. Either a integer which | ||
| #' represents the main dimensions (1=spatial, 2=temporal, 3=data) or a numeric, | ||
| #' representing the subdimensions of a dimension (e.g. 3.2 for the second data | ||
| #' dimension). | ||
| #' @author Jan Philipp Dietrich, Kristine Karstens | ||
| #' @seealso \code{\link{mselect}}, \code{\link{getDim}} | ||
| #' @examples | ||
| #' | ||
| #' data(population_magpie) | ||
| #' dimCode(c("t","scenario","blablub"),population_magpie) | ||
| #' | ||
| #' @export dimCode | ||
| dimCode <- function(dim, x, missing=0, sep="."){ | ||
|
|
||
| #function to translate dim to dim code | ||
| if(is.character(dim)) { | ||
|
|
||
| # get super dims and initialize dim number array | ||
| set <- getSets(x, fulldim=FALSE, sep=sep) | ||
| dnames <- dim | ||
| dim <- numeric() | ||
|
|
||
| # loop over all entries for dim | ||
| for(i in (1:length(dnames))){ | ||
|
|
||
| # get superdim and check for appearance and uniqueness | ||
| superdim <- grep(paste0("(\\.|^)",dnames[i],"(\\.|$)"), set) | ||
|
|
||
| if(length(superdim) > 1) {stop('One or more elements were found more than once in x!') | ||
| } else if(length(superdim) == 0) {dim[i] <- 0 | ||
| } else { | ||
|
|
||
| # split in subdims and calculate dimension Code | ||
| tmp <- unlist(strsplit(set[superdim], split=sep, fixed=TRUE)) | ||
|
|
||
| if(length(tmp)>1){ | ||
| subdim <- grep(paste0("^",dnames[i],"($)"), tmp) | ||
| if(length(subdim) > 1) stop('One or more elements were found more than once or not at all in x!') | ||
| } else {subdim <- 0} | ||
|
|
||
| dim[i] <- as.numeric(superdim + subdim/10) | ||
| } | ||
| } | ||
|
|
||
| names(dim) <- dnames | ||
| } | ||
|
|
||
| # check for errors and set "missing" | ||
| if(any(dim>=4) | any(dim<1)) { | ||
| if(missing=="stop") stop("illegal dimension. Use either dimension 1, 2, or 3, or if you want to address subdimensions use 3.1, 3.2, ...") | ||
| dim[dim>=4 | dim<1] <- missing | ||
| } | ||
|
|
||
| return(dim) | ||
| #' dimCode | ||
| #' | ||
| #' Function converts a dimension name or number to a dimension Code used for | ||
| #' MAgPIE objects | ||
| #' | ||
| #' | ||
| #' @param dim A vector of dimension numbers or dimension names which should be | ||
| #' translated | ||
| #' @param x MAgPIE object in which the dimensions should be searched for. | ||
| #' @param missing Either a value to which a dimension should be set in case | ||
| #' that it is not found (default is 0), or "stop" indicating that the function | ||
| #' should throw an error in these cases. | ||
| #' @param sep A character separating joined dimension names | ||
| #' @return A dimension code identifying the dimension. Either a integer which | ||
| #' represents the main dimensions (1=spatial, 2=temporal, 3=data) or a numeric, | ||
| #' representing the subdimensions of a dimension (e.g. 3.2 for the second data | ||
| #' dimension). | ||
| #' @author Jan Philipp Dietrich, Kristine Karstens | ||
| #' @seealso \code{\link{mselect}}, \code{\link{getDim}} | ||
| #' @examples | ||
| #' | ||
| #' data(population_magpie) | ||
| #' dimCode(c("t","scenario","blablub"),population_magpie) | ||
| #' | ||
| #' @export dimCode | ||
| dimCode <- function(dim, x, missing=0, sep="."){ | ||
|
|
||
| #function to translate dim to dim code | ||
| if(is.character(dim)) { | ||
|
|
||
| # get super dims and initialize dim number array | ||
| set <- getSets(x, fulldim=FALSE, sep=sep) | ||
| dnames <- dim | ||
| dim <- numeric() | ||
|
|
||
| # loop over all entries for dim | ||
| for(i in (1:length(dnames))){ | ||
|
|
||
| # get superdim and check for appearance and uniqueness | ||
| superdim <- grep(paste0("(\\.|^)",dnames[i],"(\\.|$)"), set) | ||
|
|
||
| if(length(superdim) > 1) {stop('One or more elements were found more than once in x!') | ||
| } else if(length(superdim) == 0) {dim[i] <- 0 | ||
| } else { | ||
|
|
||
| # split in subdims and calculate dimension Code | ||
| tmp <- unlist(strsplit(set[superdim], split=sep, fixed=TRUE)) | ||
|
|
||
| if(length(tmp)>1){ | ||
| subdim <- grep(paste0("^",dnames[i],"($)"), tmp) | ||
| if(length(subdim) > 1) stop('One or more elements were found more than once or not at all in x!') | ||
| } else {subdim <- 0} | ||
|
|
||
| dim[i] <- as.numeric(superdim + subdim/10) | ||
| } | ||
| } | ||
|
|
||
| names(dim) <- dnames | ||
| } | ||
|
|
||
| # check for errors and set "missing" | ||
| if(any(dim>=4) | any(dim<1)) { | ||
| if(missing=="stop") stop("illegal dimension. Use either dimension 1, 2, or 3, or if you want to address subdimensions use 3.1, 3.2, ...") | ||
| dim[dim>=4 | dim<1] <- missing | ||
| } | ||
|
|
||
| return(dim) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,41 +1,41 @@ | ||
| #' @title magpply | ||
| #' @description apply command for magpieobjects. Very efficient for replacing loops. | ||
| #' | ||
| #' @param X magpie object | ||
| #' @param FUN function that shall be applied X | ||
| #' @param MARGIN dimension over which FUN shall be applied (like a loop over that dimension). This dimension will be preserved in the output object | ||
| #' @param ... further parameters passed on to FUN | ||
| #' @param integrate if TRUE, the output will be filled into an magpie object of the same dimensionality as X | ||
| #' | ||
| #' @return magpie object | ||
| #' @author Benjamin Leon Bodirsky | ||
| #' @examples | ||
| #' | ||
| #' \dontrun{ | ||
| #' data("population_magpie") | ||
| #' magpply(population_magpie,FUN=sum,MARGIN=2) | ||
| #' fourdim<-population_magpie*setNames(population_magpie,c("jkk","lk")) | ||
| #' magpply(fourdim,FUN=sum,MARGIN=c(1,3.1)) | ||
| #' magpply(fourdim,FUN=function(x){return(x+1)},MARGIN=c(1,3.1),integrate=TRUE) | ||
| #' } | ||
| #' | ||
| #' @export magpply | ||
|
|
||
| magpply<-function(X,FUN,MARGIN,...,integrate=FALSE){ | ||
| if(any(MARGIN>3)){ | ||
| for(counter in which(MARGIN>3)){ | ||
| MARGIN[counter]=old_dim_convention(MARGIN[counter]) | ||
| } | ||
| X<-unwrap(X) | ||
| } | ||
|
|
||
| out<-apply(X = X,FUN = FUN,MARGIN=MARGIN) | ||
| if(integrate==TRUE){ | ||
| X[,,]<-out | ||
| out<-X | ||
| } else { | ||
| out<-as.magpie(out) | ||
| } | ||
| out <- updateMetadata(out,X,unit="copy",source="copy",calcHistory="copy",description="copy") | ||
| return(out) | ||
| #' @title magpply | ||
| #' @description apply command for magpieobjects. Very efficient for replacing loops. | ||
| #' | ||
| #' @param X magpie object | ||
| #' @param FUN function that shall be applied X | ||
| #' @param MARGIN dimension over which FUN shall be applied (like a loop over that dimension). This dimension will be preserved in the output object | ||
| #' @param ... further parameters passed on to FUN | ||
| #' @param integrate if TRUE, the output will be filled into an magpie object of the same dimensionality as X | ||
| #' | ||
| #' @return magpie object | ||
| #' @author Benjamin Leon Bodirsky | ||
| #' @examples | ||
| #' | ||
| #' \dontrun{ | ||
| #' data("population_magpie") | ||
| #' magpply(population_magpie,FUN=sum,MARGIN=2) | ||
| #' fourdim<-population_magpie*setNames(population_magpie,c("jkk","lk")) | ||
| #' magpply(fourdim,FUN=sum,MARGIN=c(1,3.1)) | ||
| #' magpply(fourdim,FUN=function(x){return(x+1)},MARGIN=c(1,3.1),integrate=TRUE) | ||
| #' } | ||
| #' | ||
| #' @export magpply | ||
|
|
||
| magpply<-function(X,FUN,MARGIN,...,integrate=FALSE){ | ||
| if(any(MARGIN>3)){ | ||
| for(counter in which(MARGIN>3)){ | ||
| MARGIN[counter]=old_dim_convention(MARGIN[counter]) | ||
| } | ||
| X<-unwrap(X) | ||
| } | ||
|
|
||
| out<-apply(X = X,FUN = FUN,MARGIN=MARGIN) | ||
| if(integrate==TRUE){ | ||
| X[,,]<-out | ||
| out<-X | ||
| } else { | ||
| out<-as.magpie(out) | ||
| } | ||
| out <- updateMetadata(out,X,unit="copy",source="copy",calcHistory="copy",description="copy") | ||
| return(out) | ||
| } |
Oops, something went wrong.