Skip to content

Commit

Permalink
Metadata units handling feature merge-in
Browse files Browse the repository at this point in the history
Merge branch 'master' of https://github.com/pik-piam/magclass into units

# Conflicts:
#	DESCRIPTION
#	R/getMetadata.R
#	R/updateMetadata.R
  • Loading branch information
stephenbi committed Dec 17, 2018
2 parents 5d25bcf + b8f371f commit 6cd8220
Show file tree
Hide file tree
Showing 11 changed files with 163 additions and 96 deletions.
7 changes: 4 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,13 +1,14 @@
Package: magclass
Type: Package
Title: Data Class and Tools for Handling Spatial-Temporal Data
Version: 4.91.0
Date: 2018-12-13
Version: 4.90.0
Date: 2018-12-17
Authors@R: c(person("Jan Philipp", "Dietrich", email = "dietrich@pik-potsdam.de", role = c("aut","cre")),
person("Benjamin Leon", "Bodirsky", email = "bodirsky@pik-potsdam.de", role = "aut"),
person("Markus", "Bonsch", role = "aut"),
person("Florian", "Humpenoeder", email = "humpenoeder@pik-potsdam.de", role = "aut"),
person("Stephen", "Bi", role = "aut"),
person("Kristine", "Karstens", email = "karstens@pik-potsdam.de", role = "aut"),
person("Lavinia", "Baumstark", email = "lavinia@pik-potsdam.de", role = "ctb"),
person("Christoph", "Bertram", email = "bertram@pik-potsdam.de", role = "ctb"),
person("Anastasis", "Giannousakis", email = "giannou@pik-potsdam.de", role = "ctb"),
Expand Down Expand Up @@ -47,4 +48,4 @@ LazyData: true
Encoding: UTF-8
RoxygenNote: 6.1.1
VignetteBuilder: knitr
ValidationKey: 87780980
ValidationKey: 87621800
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ export(magpieComp)
export(magpieResolution)
export(magpie_expand)
export(magpiesort)
export(magpply)
export(mbind)
export(mbind2)
export(mcalc)
Expand Down
2 changes: 1 addition & 1 deletion R/dimCode.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@
#' 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
#' @author Jan Philipp Dietrich, Kristine Karstens
#' @seealso \code{\link{mselect}}, \code{\link{getDim}}
#' @examples
#'
Expand Down
2 changes: 1 addition & 1 deletion R/getMetadata.R
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@
#' @export

getMetadata <- function(x, type=NULL) {
if(!withMetadata()) return(NULL)
if(!withMetadata()) return(NULL)
if (Sys.getlocale("LC_CTYPE")!="en_US.UTF-8") tmp <- suppressWarnings(Sys.setlocale("LC_ALL","en_US.UTF-8"))
if (!requireNamespace("data.tree", quietly = TRUE)) stop("The package data.tree is required for metadata handling!")
units_options(auto_convert_names_to_symbols=FALSE, allow_mixed=TRUE)
Expand Down
18 changes: 13 additions & 5 deletions R/install_magpie_units.R
Original file line number Diff line number Diff line change
Expand Up @@ -47,13 +47,21 @@ install_magpie_units <- function(x=NULL) {
z <- gsub("bn_","billion_",z,ignore.case=TRUE)
}
if (grepl("1e",substr(z,1,2),ignore.case=TRUE)) {
if (grepl("+",z,fixed=TRUE)) {
z <- gsub("+","",z,fixed=TRUE)
}
if (grepl("*",z,fixed=TRUE)) {
z <- unlist(strsplit(z,"*",fixed=TRUE))
prefix <- z[1]
z <- z[2]
}else {
z <- gsub("1e","",z,ignore.case=TRUE)
prefix <- paste0("1e",unlist(strsplit(z,"\\D"))[1])
if (grepl("^-",z)) {
z <- gsub("^-","",z)
prefix <- paste0("1e-",unlist(strsplit(z,"\\D"))[1])
}else {
prefix <- paste0("1e",unlist(strsplit(z,"\\D"))[1])
}
z <- gsub("^\\d*","",z)
}
}else {
Expand Down Expand Up @@ -115,7 +123,7 @@ install_magpie_units <- function(x=NULL) {
}else if (tmp!="") z <- tmp
}
if (grepl("^\\d",z)) {
if (is.installed(gsub("^\\d*","",z))) {
if (is.installed(gsub("^\\d*","",remove_spaces(z)))) {
prefix[length(prefix)+1] <- unlist(regmatches(z,gregexpr("^\\d*",z)))
z <- gsub("^\\d*","",z)
}else {
Expand Down Expand Up @@ -180,10 +188,11 @@ install_magpie_units <- function(x=NULL) {
z <- gsub("_%","_percent",z,fixed=TRUE)
z <- gsub("%","percent_",z,fixed=TRUE)
}
if (grepl("([.|()\\{}+$?:]|\\[|\\])",z)) {
z <- gsub("([.|()\\{}+$?:]|\\[|\\])","",z)
if (grepl("([.|#!@&~()\\{}+$?:]|\\[|\\])",z)) {
warning("Unit entry \"",z,"\" contained invalid special characters which have now been removed. Please revise.")
z <- gsub("([.|#!@&~()\\{}+$?:]|\\[|\\])","",z)
}
if (any(paste0(prefix,z)==c("","_","__","-"))) z <- "unknown"
z <- prefix_check(prefix,paste0(z,suffix))
return(z)
}
Expand Down Expand Up @@ -304,7 +313,6 @@ install_magpie_units <- function(x=NULL) {

input_unit <- function(a) {
a <- gsub(" ","_",a)
a <- gsub("-","_",a)
if (grepl("_or_",a,fixed=TRUE)) {
a <- gsub("_or_",",",a,fixed=TRUE)
}
Expand Down
78 changes: 40 additions & 38 deletions R/magpply.R
Original file line number Diff line number Diff line change
@@ -1,39 +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)
#' }
#'

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)
}
45 changes: 41 additions & 4 deletions R/read.magpie.R
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@
#' will be treated and counted as a new region (e.g.
#' AFR.1,AFR.2,CPA.3,CPA.4,AFR.5 will count AFR twice and nregions will be set
#' to 3!).
#' @author Jan Philipp Dietrich, Stephen Bi
#' @author Jan Philipp Dietrich, Stephen Bi, Florian Humpenoeder
#' @seealso \code{"\linkS4class{magpie}"}, \code{\link{write.magpie}}
#' @examples
#'
Expand Down Expand Up @@ -253,6 +253,20 @@ read.magpie <- function(file_name,file_folder="",file_type=NULL,as.array=FALSE,o
}
names(metadata[[i]]) <- name
}
}else if (field[i]=="unit") {
metadata[[i]] <- unlist(strsplit(tmp2,": ",fixed=TRUE))[2]
if (grepl(",",metadata[[i]])) {
metadata[[i]] <- install_magpie_units("unknown")
#Mixed Units handling in development

}else if (grepl("^\\d",metadata[[i]])) {
unitChar <- unlist(strsplit(metadata[[i]]," "))
unitChar[2] <- as.character(units(install_magpie_units(unitChar[2])))
metadata[[i]] <- as_units(as.numeric(unitChar[1]),unitChar[2])
}else {
metadata[[i]] <- install_magpie_units(metadata[[i]])
}
tmp <- readLines(zz,1)
}else {
metadata[[i]] <- unlist(strsplit(tmp2,": ",fixed=TRUE))[2]
tmp <- readLines(zz,1)
Expand Down Expand Up @@ -412,6 +426,19 @@ read.magpie <- function(file_name,file_folder="",file_type=NULL,as.array=FALSE,o
if(is.null(nc_file$dim$time$len)) nc_file$dim$time$len <- 1
if(is.null(nc_file$dim$time$vals)) nc_file$dim$time$vals <- 1995

if(length(nc_file$groups) == 1) {
var_names <- names(nc_file$var)
} else {
var_names <- NULL
for (i in 1:nc_file$nvars) {
var_name <- nc_file$var[[i]]$longname
group_index <- nc_file$var[[i]]$group_index
group_name <- nc_file$groups[[group_index]]$fqgn
var_names <- c(var_names,paste(group_name,var_name,sep="/"))
var_names <- gsub("/",".",var_names)
}
}

#create a single array of all ncdf variables
nc_data <- array(NA,dim=c(nc_file$dim$lon$len,nc_file$dim$lat$len,nc_file$dim$time$len,nc_file$nvars))
for (i in 1:nc_file$nvars) {
Expand All @@ -426,14 +453,24 @@ read.magpie <- function(file_name,file_folder="",file_type=NULL,as.array=FALSE,o

#reorder ncdf array into magpie cellular format (still as array)
#create emtpy array in magpie cellular format
mag <- array(NA,dim=c(59199,nc_file$dim$time$len,nc_file$nvars),dimnames=list(paste(magclassdata$half_deg$region,1:59199,sep="."),paste("y",nc_file$dim$time$vals,sep=""),names(nc_file$var)))
mag <- array(NA,dim=c(59199,nc_file$dim$time$len,nc_file$nvars),dimnames=list(paste("GLO",1:59199,sep="."),paste("y",nc_file$dim$time$vals,sep=""),var_names))
#Loop over cells to give mag values taken from nc_data. For each cell in mag, we know the exact coordinates (coord). Hence, we can use coord to map coordinates in nc_data to cells in mag.
for (i in 1:ncells(mag)) {
mag[i,,] <- nc_data[which(coord[i, 1]==lon), which(coord[i,2]==lat),,]
}

metadata <- list()
if(ncdf4::ncatt_get(nc_file,varid=0,attname="unit")[[1]]) metadata$unit <- ncdf4::ncatt_get(nc_file,varid=0,attname="unit")[[2]]
if(ncdf4::ncatt_get(nc_file,varid=0,attname="unit")[[1]]) {
unitChar <- ncdf4::ncatt_get(nc_file,varid=0,attname="unit")[[2]]
#Mixed units handling in development
if (grepl("^\\d",unitChar)) {
unitChar <- unlist(strsplit(unitChar," "))
unitChar[2] <- as.character(units(install_magpie_units(unitChar[2])))
metadata$unit <- as_units(as.numeric(unitChar[1]),unitChar[2])
}else {
metadata$unit <- install_magpie_units(unitChar)
}
}
if(ncdf4::ncatt_get(nc_file,varid=0,attname="user")[[1]]) metadata$user <- ncdf4::ncatt_get(nc_file,varid=0,attname="user")[[2]]
if(ncdf4::ncatt_get(nc_file,varid=0,attname="date")[[1]]) metadata$date <- ncdf4::ncatt_get(nc_file,varid=0,attname="date")[[2]]
if(ncdf4::ncatt_get(nc_file,varid=0,attname="description")[[1]]) metadata$description <- ncdf4::ncatt_get(nc_file,varid=0,attname="description")[[2]]
Expand Down Expand Up @@ -481,7 +518,7 @@ read.magpie <- function(file_name,file_folder="",file_type=NULL,as.array=FALSE,o
}

#convert array to magpie object
read.magpie <- as.magpie(mag)
read.magpie <- clean_magpie(as.magpie(mag))
getMetadata(read.magpie) <- metadata

} else {
Expand Down
72 changes: 32 additions & 40 deletions R/updateMetadata.R
Original file line number Diff line number Diff line change
Expand Up @@ -98,61 +98,53 @@ updateMetadata <- function(x, y=NULL, unit=ifelse(is.null(y),"keep","update"), s
tmp[2] <- paste(tmp[-1],collapse="(")
}
tmp <- gsub(".{1}$","",tmp[2])
args <- unlist(strsplit(tmp,",",fixed=TRUE))
arg <- unlist(strsplit(tmp,",",fixed=TRUE))
fchanged <- FALSE
for(i in 1:length(args)){
if (grepl("(",args[i],fixed=TRUE)) {
for(i in 1:length(arg)){
if (grepl("(",arg[i],fixed=TRUE)) {
j <- i
while (!grepl(")",args[j],fixed=TRUE)) {
if (grepl("(",args[j],fixed=TRUE)) {
if (j>i | length(regmatches(args[j],gregexpr("(",args[j],fixed=TRUE)))>1) {
while (!grepl(")",args[j],fixed=TRUE)) {
args[i] <- paste0(args[i],",",args[j])
args <- args[-j]
if (j==length(args)) break
while (!grepl(")",arg[j],fixed=TRUE)) {
if (grepl("(",arg[j],fixed=TRUE)) {
if (j>i | length(regmatches(arg[j],gregexpr("(",arg[j],fixed=TRUE)))>1) {
while (!grepl(")",arg[j],fixed=TRUE)) {
arg[i] <- paste0(arg[i],",",arg[j])
arg <- arg[-j]
if (j>=length(arg)) break
else j <- j+1
}
}
}
if (j>=length(args)) break
if (j>=length(arg)) break
else j <- j+1
args[i] <- paste0(args[i],",",args[j])
args <- args[-j]
arg[i] <- paste0(arg[i],",",arg[j])
arg <- arg[-j]
}
if (grepl("=",args[i],fixed=TRUE)) {
tmp <- unlist(strsplit(args[i],"=",fixed=TRUE))
tmp[2] <- eval.parent(parse(text=tmp[2]),n=n+1)
args[i] <- paste0(tmp[1],"= \"",tmp[2],"\"")
}else {
args[i] <- eval.parent(parse(text=args[i]),n=n+1)
args[i] <- paste0("\"",args[i],"\"")
}
if(grepl("=",arg[i],fixed=TRUE)) {
tmp <- trimws(unlist(strsplit(arg[i],"=",fixed=TRUE)))
if (length(tmp)>2) {
tmp[2] <- paste(tmp[-1],collapse=", ")
}
fchanged <- TRUE
}else {
tmp <- c(NA,arg[i])
}
if(grepl("=",args[i],fixed=TRUE)) {
tmp <- trimws(unlist(strsplit(args[i],"=",fixed=TRUE)))
if(tmp[1]==tmp[2]) {
if (grepl("(",tmp[2],fixed=TRUE) & !grepl("c(",substr(tmp[2],1,2),fixed=TRUE) & !grepl("list(",tmp[2],fixed=TRUE)) {
tmp[2] <- eval.parent(parse(text=tmp[2]),n=n+1)
fchanged <- TRUE
}else if(!grepl("\u0022",tmp[2]) & grepl("[[:alpha:]]",tmp[2])) {
if (!any(tmp[2]==c("T","F","TRUE","FALSE","NULL"))) {
tmp[2] <- get(tmp[2],envir=parent.frame(n+1))
args[i] <- paste0(tmp[1]," = \"",tmp[2],"\"")
fchanged <- TRUE
}else if(!grepl("\u0022",tmp[2]) & grepl("[[:alpha:]]",tmp[2])) {
if (!any(tmp[2]==c("T","F","TRUE","FALSE"))) {
tmp[2] <- get(tmp[2],envir=parent.frame(n+1))
if(length(tmp[2])>1) tmp[2] <- paste(tmp[2],collapse=", ")
args[i] <- paste0(tmp[1]," = \"",tmp[2],"\"")
fchanged <- TRUE
}
}
}else if(!grepl("\u0022",args[i]) & grepl("[[:alpha:]]",args[i])) {
if (!any(args[i]==c("T","F","TRUE","FALSE"))) {
tmp <- get(args[i],envir=parent.frame(n+1))
if(length(tmp)>1) tmp <- paste(tmp,collapse=", ")
args[i] <- paste0("\"",tmp,"\"")
if(length(tmp[2])>1) { tmp[2] <- paste(tmp[2],collapse=", ") }
fchanged <- TRUE
}
}
if (!is.na(tmp[1])) {
arg[i] <- paste0(tmp[1]," = \"",tmp[2],"\"")
}else {
arg[i] <- tmp[2]
}
}
if(fchanged==TRUE) f <- paste0(fname,"(",paste(args,collapse=", "),")")
if(fchanged==TRUE) f <- paste0(fname,"(",paste(arg,collapse=", "),")")
}
if (convert==TRUE) return(data.tree::Node$new(f))
else return(f)
Expand Down
16 changes: 15 additions & 1 deletion R/write.magpie.R
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,21 @@ write.magpie <- function(x,file_name,file_folder="",file_type=NULL,append=FALSE,
#function to write metadata to cs* filetypes
.writeMetadata <- function(file,metadata,char,mchar) {
if(!is.null(metadata$unit)) {
writeLines(paste(char,paste0(mchar,"unit:"),metadata$unit),file)
if (is(metadata$unit,"units")) {
if (as.numeric(metadata$unit)==1) {
unit <- as.character(units(metadata$unit))
}else {
unit <- paste(as.character(metadata$unit),as.character(units(metadata$unit)))
}
}else if (is.character(metadata$unit)) {
unit <- metadata$unit
#Mixed units handling in development
#}else if (is(metadata$unit,"units")) {
#unit <- paste(as.character(metadata$unit),as.character(units(metadata$unit)),collapse=", ")
}else {
unit <- "unknown"
}
writeLines(paste(char,paste0(mchar,"unit:"),paste(unit,collapse=", ")),file)
writeLines(char,file)
}
if(!is.null(metadata$user)) {
Expand Down
Loading

0 comments on commit 6cd8220

Please sign in to comment.