From 051c7a0a1203efd7b5b7c051238882174acbbcf1 Mon Sep 17 00:00:00 2001 From: Stephen Bi Date: Mon, 15 Jan 2018 15:54:22 +0100 Subject: [PATCH] Minor improvements to metadata handling --- DESCRIPTION | 2 +- R/add_columns.R | 1 - R/as.magpie.R | 23 ++++--- R/clean_magpie.R | 164 ++++++++++++++++++++++---------------------- R/complete_magpie.R | 2 +- R/dimReduce.R | 5 +- R/getMetadata.R | 70 +++++++++++++++---- R/magpply.R | 2 +- R/mbind2.R | 18 +++-- R/new.magpie.R | 7 +- R/ops-method.R | 1 - R/updateMetadata.R | 42 +++++++----- 12 files changed, 193 insertions(+), 144 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 498c902f..f05dad4c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: magclass Type: Package Title: Data Class and Tools for Handling Spatial-Temporal Data -Version: 4.72.3 +Version: 4.72.4 Author: Jan Philipp Dietrich, Benjamin Bodirsky, Misko Stevanovic, diff --git a/R/add_columns.R b/R/add_columns.R index a035dea8..8b503c14 100644 --- a/R/add_columns.R +++ b/R/add_columns.R @@ -40,7 +40,6 @@ add_columns<-function(x,addnm=c("new"),dim=3.1){ }} new_columns[,,]<-NA } - getMetadata(new_columns) <- NULL output <- mbind(x,new_columns) return(output) } diff --git a/R/as.magpie.R b/R/as.magpie.R index 0dd7e070..3892ec2a 100644 --- a/R/as.magpie.R +++ b/R/as.magpie.R @@ -16,7 +16,7 @@ tmpfilter <- function(x, sep="\\.", replacement="_") { setMethod("as.magpie", signature(x = "lpj"), - function (x, ...) + function (x, unit="1", ...) { xdimnames <- dimnames(x) xdim <- dim(x) @@ -24,13 +24,13 @@ setMethod("as.magpie", dimnames(x) <- list(paste(magclassdata$half_deg$region,1:59199,sep='.'), xdimnames[[2]], paste(rep(xdimnames[[3]],xdim[4]),rep(xdimnames[[4]],each=xdim[3]),sep=".")) - return(new("magpie",x)) + return(updateMetadata(new("magpie",x), unit=unit)) } ) setMethod("as.magpie", signature(x = "array"), - function (x, spatial=NULL, temporal=NULL, ...) + function (x, spatial=NULL, temporal=NULL, unit="1", ...) { store_attributes <- copy.attributes(x,0) @@ -148,15 +148,15 @@ setMethod("as.magpie", #Now temporal and regiospatial dimension should both exist #Return MAgPIE object - return(copy.attributes(store_attributes,new("magpie",wrap(x,list(d$regiospatial,d$temporal,NA))))) + return(updateMetadata(copy.attributes(store_attributes,new("magpie",wrap(x,list(d$regiospatial,d$temporal,NA)))), unit=unit)) } ) setMethod("as.magpie", signature(x = "numeric"), - function(x,...) + function(x, unit="1", ...) { - return(copy.attributes(x,as.magpie(as.array(x),...))) + return(updateMetadata(copy.attributes(x,as.magpie(as.array(x),...)), unit=unit)) } ) @@ -170,7 +170,7 @@ setMethod("as.magpie", setMethod("as.magpie", signature(x = "data.frame"), - function (x, datacol=NULL, tidy=FALSE, sep=".", replacement="_", ...) + function (x, datacol=NULL, tidy=FALSE, sep=".", replacement="_", unit="1", ...) { # filter illegal characters for(i in 1:dim(x)[2]) { @@ -193,7 +193,7 @@ setMethod("as.magpie", if(datacol==dim(x)[2]) return(tidy2magpie(x,...)) x[[datacol-1]] <- as.factor(x[[datacol-1]]) } - return(copy.attributes(x,tidy2magpie(suppressMessages(reshape2::melt(x)),...))) + return(updateMetadata(copy.attributes(x,tidy2magpie(suppressMessages(reshape2::melt(x)),...)), unit=unit)) } ) @@ -262,19 +262,20 @@ setMethod("as.magpie", #put value column as last column x <- x[c(which(names(x)!="value"),which(names(x)=="value"))] - return(tidy2magpie(x,spatial="region",temporal="period")) + return(updateMetadata(tidy2magpie(x,spatial="region",temporal="period"))) } ) setMethod("as.magpie", signature(x = "tbl_df"), - function(x, ...) + function(x, unit="1", ...) { if("quitte" %in% class(x)) { class(x) <- c("quitte","data.frame") + return(updateMetadata(as.magpie(x,...))) } else { class(x) <- "data.frame" + return(updateMetadata(as.magpie(x,...), unit=unit)) } - return(as.magpie(x,...)) } ) diff --git a/R/clean_magpie.R b/R/clean_magpie.R index 6a5a4013..db4a2c8a 100644 --- a/R/clean_magpie.R +++ b/R/clean_magpie.R @@ -1,82 +1,82 @@ -#' MAgPIE-Clean -#' -#' Function cleans MAgPIE objects so that they follow some extended magpie -#' object rules (currently it makes sure that the dimnames have names and -#' removes cell numbers if it is purely regional data) -#' -#' -#' @param x MAgPIE object which should be cleaned. -#' @param what term defining what type of cleaning should be performed. Current -#' modes are "cells" (removes cell numbers if the data seems to be regional - -#' this should be used carefully as it might remove cell numbers in some cases -#' in which they should not be removed), "sets" (making sure that all -#' dimensions have names) and "all" (performing all available cleaning methods) -#' @return The eventually corrected MAgPIE object -#' @author Jan Philipp Dietrich -#' @seealso \code{"\linkS4class{magpie}"} -#' @examples -#' -#' data(population_magpie) -#' a <- clean_magpie(population_magpie) -#' -#' @export clean_magpie -clean_magpie <- function(x,what="all") { - if(!(what %in% c("all","cells","sets"))) stop('Unknown setting for argument what ("',what,'")!') - #remove cell numbers if data is actually regional - if(what=="all" | what =="cells") { - if(ncells(x)==nregions(x)) { - getCells(x) <- getRegions(x) - if(!is.null(names(dimnames(x))[[1]])) { - if(!is.na(names(dimnames(x))[[1]])) { - names(dimnames(x))[[1]] <- sub("\\..*$","",names(dimnames(x))[[1]]) - } - } - } - } - #make sure that all dimensions have names - if(what=="all" | what =="sets") { - - if(is.null(names(dimnames(x)))) names(dimnames(x)) <- rep(NA,3) - - .count_subdim <- function(x,sep="\\.") { - o <- nchar(gsub(paste0("[^",sep,"]*"),"",x))+1 - if(length(o)==0) o <- 0 - return(o) - } - - names <- names(dimnames(x)) - if(!is.na(names[1]) & (names[1]!="") & (names[1]!="NA")) { - c1 <- .count_subdim(dimnames(x)[[1]][1]) - c2 <- .count_subdim(names[1]) - if(c1!=c2) { - if(c1>2) stop("More than 2 spatial subdimensions not yet implemented") - names[1] <- paste(names[1],"cell",sep=".") - } - } else { - names[1] <- ifelse(all(grepl("\\.",dimnames(x)[[1]])),"region.cell","region") - } - if(is.na(names[2]) | names[2]=="NA" | names[2]=="") { - names[2] <- "year" - } - if(is.na(names[3]) | names[3]=="" | names[3]=="NA") { - ndim <- nchar(gsub("[^\\.]","",getNames(x)[1])) +1 - names[3] <- ifelse(length(ndim)>0,paste0("data",1:ndim,collapse="."),"data1") - } else { - c1 <- .count_subdim(dimnames(x)[[3]][1]) - c2 <- .count_subdim(names[3]) - if(c1!=c2) { - if(c1>c2) { - names[3] <- paste(c(names[3],rep("data",c1-c2)),collapse=".") - } else { - search <- paste0(c(rep("\\.[^\\.]*",c2-c1),"$"),collapse="") - names[3] <- sub(search,"",names[3]) - } - names[3] <- paste0(make.unique(strsplit(names[3],"\\.")[[1]],sep = ""),collapse=".") - - } - } - - names(dimnames(x)) <- names - } - return(x) -} +#' MAgPIE-Clean +#' +#' Function cleans MAgPIE objects so that they follow some extended magpie +#' object rules (currently it makes sure that the dimnames have names and +#' removes cell numbers if it is purely regional data) +#' +#' +#' @param x MAgPIE object which should be cleaned. +#' @param what term defining what type of cleaning should be performed. Current +#' modes are "cells" (removes cell numbers if the data seems to be regional - +#' this should be used carefully as it might remove cell numbers in some cases +#' in which they should not be removed), "sets" (making sure that all +#' dimensions have names) and "all" (performing all available cleaning methods) +#' @return The eventually corrected MAgPIE object +#' @author Jan Philipp Dietrich +#' @seealso \code{"\linkS4class{magpie}"} +#' @examples +#' +#' data(population_magpie) +#' a <- clean_magpie(population_magpie) +#' +#' @export clean_magpie +clean_magpie <- function(x,what="all") { + if(!(what %in% c("all","cells","sets"))) stop('Unknown setting for argument what ("',what,'")!') + #remove cell numbers if data is actually regional + if(what=="all" | what =="cells") { + if(ncells(x)==nregions(x)) { + getCells(x) <- getRegions(x) + if(!is.null(names(dimnames(x))[[1]])) { + if(!is.na(names(dimnames(x))[[1]])) { + names(dimnames(x))[[1]] <- sub("\\..*$","",names(dimnames(x))[[1]]) + } + } + } + } + #make sure that all dimensions have names + if(what=="all" | what =="sets") { + + if(is.null(names(dimnames(x)))) names(dimnames(x)) <- rep(NA,3) + + .count_subdim <- function(x,sep="\\.") { + o <- nchar(gsub(paste0("[^",sep,"]*"),"",x))+1 + if(length(o)==0) o <- 0 + return(o) + } + + names <- names(dimnames(x)) + if(!is.na(names[1]) & (names[1]!="") & (names[1]!="NA")) { + c1 <- .count_subdim(dimnames(x)[[1]][1]) + c2 <- .count_subdim(names[1]) + if(c1!=c2) { + if(c1>2) stop("More than 2 spatial subdimensions not yet implemented") + names[1] <- paste(names[1],"cell",sep=".") + } + } else { + names[1] <- ifelse(all(grepl("\\.",dimnames(x)[[1]])),"region.cell","region") + } + if(is.na(names[2]) | names[2]=="NA" | names[2]=="") { + names[2] <- "year" + } + if(is.na(names[3]) | names[3]=="" | names[3]=="NA") { + ndim <- nchar(gsub("[^\\.]","",getNames(x)[1])) +1 + names[3] <- ifelse(length(ndim)>0,paste0("data",1:ndim,collapse="."),"data1") + } else { + c1 <- .count_subdim(dimnames(x)[[3]][1]) + c2 <- .count_subdim(names[3]) + if(c1!=c2) { + if(c1>c2) { + names[3] <- paste(c(names[3],rep("data",c1-c2)),collapse=".") + } else { + search <- paste0(c(rep("\\.[^\\.]*",c2-c1),"$"),collapse="") + names[3] <- sub(search,"",names[3]) + } + names[3] <- paste0(make.unique(strsplit(names[3],"\\.")[[1]],sep = ""),collapse=".") + + } + } + + names(dimnames(x)) <- names + } + return(updateMetadata(x)) +} diff --git a/R/complete_magpie.R b/R/complete_magpie.R index 1d70d76f..5e66847d 100644 --- a/R/complete_magpie.R +++ b/R/complete_magpie.R @@ -35,6 +35,6 @@ complete_magpie<-function(x,fill=NA) { out<-mbind(x,add) } else {out<-x} out<-out[,,order(getNames(out))] - if (isTRUE(getOption("magclass_metadata"))) getMetadata(out) <- getMetadata(x) + getMetadata(out) <- getMetadata(x) return(out) } diff --git a/R/dimReduce.R b/R/dimReduce.R index cfe59489..1d429b63 100644 --- a/R/dimReduce.R +++ b/R/dimReduce.R @@ -39,10 +39,9 @@ dimReduce <- function(x, dim_exclude=NULL) { if(dim(x_single)[2]==1) getYears(x_single) <- NULL # same information in all dimension entries? if(all(x - x_single == 0, na.rm = TRUE)) { - if(isTRUE(getOption("magclass_metadata"))) getMetadata(x_single) <- getMetadata(x) + getMetadata(x_single) <- getMetadata(x) x <- x_single } } - if(isTRUE(getOption("magclass_metadata"))) x <- updateMetadata(x) - return(x) + return(updateMetadata(x)) } \ No newline at end of file diff --git a/R/getMetadata.R b/R/getMetadata.R index 99418c4a..ab6fc4eb 100644 --- a/R/getMetadata.R +++ b/R/getMetadata.R @@ -46,7 +46,7 @@ getMetadata <- function(x, type=NULL) { if(!isTRUE(getOption("magclass_metadata"))) return(NULL) M <- attr(x, "Metadata") - if(is.null(M$unit)) M$unit <- 1 + if(is.null(M$unit)) M$unit <- '1' if(is.null(type)) { return(M) } else if(length(type)>1){ @@ -63,29 +63,73 @@ getMetadata <- function(x, type=NULL) { M <- attr(x, "Metadata") if (!is.list(M)) M <- list() if (is.null(type)){ - if (!is.list(value) & !is.null(value)) stop("Metadata must be a list object if no type is specified") + if (!is.list(value) & !is.null(value)) stop("Metadata must be provided as a list if no type is specified") else{ - M <- value + if (length(value$unit)>1){ + warning(value$unit," is an invalid argument for unit") + value$unit <- 1 + } + if (!is.null(value$source)){ + if (is.list(value$source)){ + for (i in 1:(length(value$source)-1)){ + if (is.list(value$source[[i]])){ + if (!is.null(value$source[[i+1]]) & !is.list(value$source[[i+1]])){ + warning("Source [",i+1,"] is not a list! Please include at least author, title, date, and journal. Also DOI, ISSN, URL, etc") + value$source[[i+1]] <- NULL + } + }else if (!is.null(value$source[[i]]) & is.list(value$source[[i+1]])){ + warning("Source [",i,"] is not a list! Please include at least author, title, date, and journal. Also DOI, ISSN, URL, etc") + value$source[[i]] <- NULL + } + } + }else{ + warning("Source must be a formatted as a list! Please include at least author, title, date, and journal. Also DOI, ISSN, URL, etc") + value$source <- NULL + } + } + if (!is.null(value$user)){ + if (!is.character(value$user) & length(value$user)!=1){ + warning(value$user," is an invalid argument for user! Please use getMetadata.R or updateMetadata.R to provide a user") + value$user <- NULL + } + } + if(!is.null(value$date)){ + if(!is.character(value$date) & length(value$date)!=1){ + warning(value$date," is an invalid argument for date! Please use getMetadata.R or updateMetadata.R to provide a date") + value$date <- NULL + } + } + if(!is.null(value$description)){ + if(!is.character(value$description)){ + warning(value$description," is an invalid argument for description!") + value$description <- NULL + } + } } + M <- value }else if (type=="unit"){ if (length(value)<=1) M[[type]] <- value else warning(value," is an invalid argument for unit!") }else if (type=="source"){ - if (is.list(value) || is.null(value)) M[[type]] <- value + if (is.null(value) || is.list(value)) M[[type]] <- value else warning("Source field must be a list! Please include at least author, title, date, and journal. DOI, ISSN, URL, etc are also encouraged") }else if (type == "calcHistory"){ - if (is.character(value)) M[[type]] <- value - else warning("calcHistory field must be a character!") + if (is.character(value)){ + if (is.list(M$calcHistory)) M$calcHistory[[length(M$calcHistory)]] <- append(M$calcHistory[[length(M$calcHistory)]],value) + else if (is.null(M[[type]])) M[[type]] <- value + else M[[type]] <- list(M[[type]],value) + }else if (is.null(value)) M[[type]] <- value + else warning(value," is an invalid argument for calcHistory! Please use getMetadata.R to provide the most recent function executed on, ",x) }else if (type=="date"){ - if (is.character(value)) M[[type]] <- value - else warning("date field must be a character!") + if ((is.character(value) & length(value)==1)) M[[type]] <- value + else warning(value," is an invalid argument for date! Please use getMetadata.R or updateMetadata.R to provide a date for ",x) }else if (type=="user"){ - if (is.character(value)) M[[type]] <- value - else warning("user field must be a character!") + if ((is.character(value) & length(value)==1)) M[[type]] <- value + else warning(value," is an invalid argument for user! Please use getMetadata.R or updateMetadata.R to provide a user for ",x) }else if (type=="description"){ - if(is.character(value) || is.null(value)) M[[type]] <- value - else warning("description field must be a character!") - } + if(is.null(value) || is.character(value)) M[[type]] <- value + else warning(value," is an invalid argument for description! Please use getMetadata.R to provide a description for ",x) + }else warning(type," is not a valid metadata field!") attr(x, "Metadata") <- M return(x) } diff --git a/R/magpply.R b/R/magpply.R index 1892d3a9..d3dfedda 100644 --- a/R/magpply.R +++ b/R/magpply.R @@ -34,6 +34,6 @@ magpply<-function(X,FUN,MARGIN,...,integrate=FALSE){ } else { out<-as.magpie(out) } - if(isTRUE(getOption("magclass_metadata"))) out <- updateMetadata(out,X,unit="copy",source="copy",calcHistory="copy",description="copy") + out <- updateMetadata(out,X,unit="copy",source="copy",calcHistory="copy",description="copy") return(out) } \ No newline at end of file diff --git a/R/mbind2.R b/R/mbind2.R index 1798d84e..291b4cdf 100644 --- a/R/mbind2.R +++ b/R/mbind2.R @@ -41,13 +41,17 @@ mbind2 <- function(...) { names(dimnames(output)) <- names(dimnames(list(...)[ismagpie][[1]])) for(i in 1:length(list(...)[ismagpie])) output[,,getNames(list(...)[ismagpie][[i]])] <- list(...)[ismagpie][[i]] } - for (i in 1:length(list(...))){ - if (getMetadata(output,"unit")!=getMetadata(list(...)[[i]],"unit")){ - u <- "mixed" - warning("Units of the magpie objects do not all match! Metadata units field will be set to mixed") - break - }else u <- "keep" - } + if (!is.null(getMetadata(output,"unit"))){ + for (i in 1:length(list(...))){ + if (!is.null(getMetadata(list(...)[[i]],"unit"))){ + if (getMetadata(output,"unit")!=getMetadata(list(...)[[i]],"unit")){ + u <- "mixed" + warning("Units of the magpie objects do not all match! Metadata units field will be set to mixed") + break + }else u <- "keep" + }else u <- "mixed" + } + }else u <- "mixed" output <- updateMetadata(output, list(...), unit=u, calcHistory="copy", source="copy", description="copy") return(output) } diff --git a/R/new.magpie.R b/R/new.magpie.R index 5ceaa8b9..e99ea5e1 100644 --- a/R/new.magpie.R +++ b/R/new.magpie.R @@ -26,7 +26,7 @@ #' #' @export new.magpie #' @importFrom methods new -new.magpie <- function(cells_and_regions="GLO",years=NULL,names=NULL,fill=NA,sort=FALSE,sets=NULL,unit=1) { +new.magpie <- function(cells_and_regions="GLO",years=NULL,names=NULL,fill=NA,sort=FALSE,sets=NULL,unit="1") { ncells <- length(cells_and_regions) nyears <- ifelse(is.null(years),1,length(years)) ndata <- ifelse(is.null(names),1,length(names)) @@ -44,7 +44,6 @@ new.magpie <- function(cells_and_regions="GLO",years=NULL,names=NULL,fill=NA,sor if(sort) object <- magpiesort(object) object <- clean_magpie(object,"sets") if(!is.null(sets)) getSets(object) <- sets - - object <- updateMetadata(object,unit=unit) - return(object) + return(updateMetadata(object,unit=unit)) + } diff --git a/R/ops-method.R b/R/ops-method.R index c21ca9db..3ad07497 100644 --- a/R/ops-method.R +++ b/R/ops-method.R @@ -2,7 +2,6 @@ #' @exportMethod Ops setMethod(Ops, signature(e1='magpie', e2='magpie'), function(e1, e2){ - if(is.null(dim(e1)) & is.null(dim(e2))) { return(callGeneric(e1@.Data,e2@.Data)) } diff --git a/R/updateMetadata.R b/R/updateMetadata.R index 4f1f4712..035a610c 100644 --- a/R/updateMetadata.R +++ b/R/updateMetadata.R @@ -1,4 +1,7 @@ -#' updateMetadata +#' updateMetadata (!experimental!) +#' +#' This function is currently experimental and non-functional by default! To activate it, +#' set options(magclass_metadata=TRUE), otherwise it will not return or modify any metadata! #' #' This function is to be used by other functions to update metadata for magclass objects #' @@ -41,9 +44,9 @@ #' \code{\link{getYears}}, \code{\link{getCPR}}, \code{\link{read.magpie}}, #' \code{\link{write.magpie}}, \code{"\linkS4class{magpie}"} #' @export - +#' updateMetadata <- function(x, y=NULL, unit="keep", source="keep", calcHistory="keep", user="update", date="update", description="keep", n=1){ - + if(!isTRUE(getOption("magclass_metadata"))) return(x) if (is.list(y)){ for (i in 1:length(y)){ if (is.magpie(y[[i]])) x <- updateMetadata(x, y[[i]], unit, source, calcHistory, user, date, description, n=n+i) @@ -54,19 +57,22 @@ updateMetadata <- function(x, y=NULL, unit="keep", source="keep", calcHistory="k Mx <- getMetadata(x) My <- getMetadata(y) - + if (unit=="copy"){ if (!is.null(y)) Mx$unit <- My$unit else warning("Units cannot be copied without a second magpie argument provided!") }else if (unit=="clear") Mx$unit <- NULL else if (unit=="update") warning("Update is an invalid argument for unit!") - else if (unit!="keep") Mx$unit <- unit + else if (unit!="keep") if(length(unit)==1) Mx$unit <- unit else warning("Invalid argument ",unit," for unit!") if (source=="copy"){ if (!is.null(y)){ - if (is.null(getMetadata(x))) Mx$source <- My$source - else if (is.list(Mx$source)) Mx$source <- append(Mx$source, list(My$source)) - else Mx$source <- list(Mx$source, My$source) + if (is.list(My$source)){ + if (is.list(Mx$source)){ + if (is.list(Mx$source[[2]])) Mx$source <- append(Mx$source, list(My$source)) + else Mx$source <- list(Mx$source, My$source) + }else Mx$source <- My$source + } }else warning("Source cannot be copied without a second magpie argument provided!") }else if (source=="update") warning("Update is an invalid argument for source! Please specify keep, copy, or clear.") else if (source=="clear") Mx$source <- NULL @@ -76,10 +82,11 @@ updateMetadata <- function(x, y=NULL, unit="keep", source="keep", calcHistory="k fn <- as.character(sys.call(-n)) if (!is.na(fn[1]) & !is.null(fn[1])){ if (is.null(y)){ - if (!is.null(Mx$calcHistory)) Mx$calcHistory <- c(Mx$calcHistory, fn[1]) + if (!is.null(Mx$calcHistory) & !is.list(Mx$calcHistory)) Mx$calcHistory <- list(Mx$calcHistory, fn[1]) + else if (is.list(Mx$calcHistory)) Mx$calcHistory <- append(Mx$calcHistory, fn[1]) else Mx$calcHistory <- fn[1] }else if (is.null(getMetadata(x))){ - if (!is.null(My$calcHistory)) Mx$calcHistory <- c(My$calcHistory, fn[1]) + if (!is.null(My$calcHistory)) Mx$calcHistory <- list(My$calcHistory, fn[1]) else Mx$calcHistory <- fn[1] }else if (is.list(Mx$calcHistory)) Mx$calcHistory[[length(Mx$calcHistory)+1]] <- c(My$calcHistory, fn[1]) else Mx$calcHistory <- list(Mx$calcHistory, c(My$calcHistory, fn[1])) @@ -91,7 +98,7 @@ updateMetadata <- function(x, y=NULL, unit="keep", source="keep", calcHistory="k else Mx$calcHistory <- list(Mx$calcHistory, My$calcHistory) }else warning("calcHistory cannot be copied without a second magpie argument provided!") }else if (calcHistory=="clear") warning("calcHistory cannot be cleared! Please specify keep, update, or copy.") - else if (calcHistory!="keep") warning("Invalid argument for calcHistory!") + else if (calcHistory!="keep") warning("Invalid argument ",calcHistory," for calcHistory!") if (user=="update"){ env <- if(.Platform$OS.type == "windows") "USERNAME" else "USER" @@ -104,7 +111,7 @@ updateMetadata <- function(x, y=NULL, unit="keep", source="keep", calcHistory="k }else if (user=="clear") Mx$user <- NULL else if (user!="keep"){ if (is.character(user) & length(user)==1) Mx$user <- user - else warning("Invalid argument for user!") + else warning("Invalid argument ",user," for user!") } if (date=="update") Mx$date <- as.character(Sys.time()) @@ -114,19 +121,16 @@ updateMetadata <- function(x, y=NULL, unit="keep", source="keep", calcHistory="k else warning("Attempting to copy a NULL date!") }else warning("date cannot be copied without a second magpie argument provided!") }else if (date=="clear") warning("date cannot be cleared! Please specify keep, copy, or update.") - else if (date!="keep") warning("Invalid argument for date!") + else if (date!="keep") warning("Invalid argument ", date," for date!") if (description=="copy"){ - if (!is.null(y)){ - if (is.null(getMetadata(x))) Mx$description <- My$description - else if (is.list(Mx$description)) Mx$description[[length(Mx$description)+1]] <- My$description - else Mx$description <- list(Mx$description, My$description) - }else warning("Description cannot be copied without a second magpie argument provided!") + if (!is.null(y)) Mx$description <- My$description + else warning("Description cannot be copied without a second magpie argument provided!") }else if (description=="clear") Mx$description <- NULL else if (description=="update") warning("Update is an invalid argument for description! Please specify keep, copy, merge, or clear.") else if (description!="keep"){ if (is.character(description)) Mx$description <- description - else warning("Invalid argument for description!") + else warning("Invalid argument ",description," for description!") } getMetadata(x) <- Mx return(x)