From c78b2e58185fd0c3648bc7f780c9785ee7c6b831 Mon Sep 17 00:00:00 2001 From: Jan Philipp Dietrich Date: Tue, 21 Sep 2021 14:59:44 +0200 Subject: [PATCH] bugfix in tidy2magpie for proper treatment of factor values --- .buildlibrary | 2 +- .zenodo.json | 2 +- DESCRIPTION | 4 +- R/tidy2magpie.R | 112 +++++++++++++++++--------------- README.md | 6 +- tests/testthat/test-as.magpie.R | 9 +++ 6 files changed, 74 insertions(+), 61 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index ef265127..27133bc7 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '11426635' +ValidationKey: '11447946' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.zenodo.json b/.zenodo.json index edb036af..166a3edb 100644 --- a/.zenodo.json +++ b/.zenodo.json @@ -1,6 +1,6 @@ { "title": "magclass: Data Class and Tools for Handling Spatial-Temporal Data", - "version": "6.0.5", + "version": "6.0.6", "description": "

Data class for increased interoperability working with spatial-\n temporal data together with corresponding functions and methods (conversions,\n basic calculations and basic data manipulation). The class distinguishes\n between spatial, temporal and other dimensions to facilitate the development\n and interoperability of tools build for it. Additional features are name-based\n addressing of data and internal consistency checks (e.g. checking for the right\n data order in calculations).<\/p>", "creators": [ { diff --git a/DESCRIPTION b/DESCRIPTION index 98202fdd..0a451bfb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: magclass Type: Package Title: Data Class and Tools for Handling Spatial-Temporal Data -Version: 6.0.5 -Date: 2021-09-17 +Version: 6.0.6 +Date: 2021-09-21 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"), diff --git a/R/tidy2magpie.R b/R/tidy2magpie.R index d4bc2fc1..9ea3fc5c 100644 --- a/R/tidy2magpie.R +++ b/R/tidy2magpie.R @@ -1,75 +1,79 @@ -tidy2magpie <- function(x,spatial=NULL,temporal=NULL) { +tidy2magpie <- function(x, spatial = NULL, temporal = NULL) { #nolint # assumption: dataframe format in which only the very last # column contains values! - if("data.frame" %in% class(x)) { + if ("data.frame" %in% class(x)) { class(x) <- "data.frame" } else { stop("Data does not seem to be a data.frame!") } sep <- "." - - if(is.null(colnames(x))) colnames(x) <- paste0("col",1:dim(x)[2]) - if(anyNA(colnames(x))) colnames(x)[is.na(colnames(x))] <- "NA" - colnames(x) <- make.unique(colnames(x),sep="") - - if(dim(x)[1]==0) return(copy.attributes(x,new.magpie(NULL))) - - if(is.null(spatial)) spatial <- colnames(x[-length(x)])[apply(x[-length(x)],2,is.spatial)] - if(is.null(temporal)) temporal <- colnames(x[-length(x)])[apply(x[-length(x)],2,is.temporal)] - if(is.numeric(spatial)) spatial <- colnames(x)[spatial] - if(is.numeric(temporal)) temporal <- colnames(x)[temporal] - - .collapsecol <- function(x,which,sep=".") { - xname <- paste(colnames(x)[which],collapse=sep) + + for (i in seq_len(ncol(x))) { + if (is.factor(x[[i]])) x[[i]] <- as.character(x[[i]]) + } + + if (is.null(colnames(x))) colnames(x) <- paste0("col", 1:dim(x)[2]) + if (anyNA(colnames(x))) colnames(x)[is.na(colnames(x))] <- "NA" + colnames(x) <- make.unique(colnames(x), sep = "") + + if (dim(x)[1] == 0) return(copy.attributes(x, new.magpie(NULL))) + + if (is.null(spatial)) spatial <- colnames(x[-length(x)])[apply(x[-length(x)], 2, is.spatial)] + if (is.null(temporal)) temporal <- colnames(x[-length(x)])[apply(x[-length(x)], 2, is.temporal)] + if (is.numeric(spatial)) spatial <- colnames(x)[spatial] + if (is.numeric(temporal)) temporal <- colnames(x)[temporal] + + .collapsecol <- function(x, which, sep = ".") { + xname <- paste(colnames(x)[which], collapse = sep) args <- list() - for(i in 1:length(which)) { - args[[i]] <- x[,which[i]] + for (i in seq_along(which)) { + args[[i]] <- x[, which[i]] } args["sep"] <- sep - out <- as.data.frame(do.call(paste,args)) + out <- as.data.frame(do.call(paste, args)) colnames(out) <- xname return(out) - } - - if(sum(colnames(x) %in% temporal)>1) { - t <- .collapsecol(x,which(colnames(x) %in% temporal),sep) - } else if(sum(colnames(x) %in% temporal)==1) { - t <- x[,which(colnames(x) %in% temporal),drop=FALSE] - } else { - t <- data.frame(year=rep("NOTIME",dim(x)[1])) + } + + if (sum(colnames(x) %in% temporal) > 1) { + t <- .collapsecol(x, which(colnames(x) %in% temporal), sep) + } else if (sum(colnames(x) %in% temporal) == 1) { + t <- x[, which(colnames(x) %in% temporal), drop = FALSE] + } else { + t <- data.frame(year = rep("NOTIME", dim(x)[1])) } t[[1]] <- as.character(t[[1]]) - - if(sum(colnames(x) %in% spatial)>1) { - s <- .collapsecol(x,which(colnames(x) %in% spatial),sep) - } else if(sum(colnames(x) %in% spatial)==1) { - s <- x[,which(colnames(x) %in% spatial),drop=FALSE] + + if (sum(colnames(x) %in% spatial) > 1) { + s <- .collapsecol(x, which(colnames(x) %in% spatial), sep) + } else if (sum(colnames(x) %in% spatial) == 1) { + s <- x[, which(colnames(x) %in% spatial), drop = FALSE] } else { - s <- data.frame(region=rep("GLO",dim(x)[1])) + s <- data.frame(region = rep("GLO", dim(x)[1])) } s[[1]] <- as.character(s[[1]]) - - if(sum(!(colnames(x)[-dim(x)[2]] %in% c(temporal,spatial)))>1) { - d <- .collapsecol(x,which(!(colnames(x)[-dim(x)[2]] %in% c(temporal,spatial))),sep) - } else if(sum(!(colnames(x)[-dim(x)[2]] %in% c(temporal,spatial)))==1) { - d <- x[,which(!(colnames(x)[-dim(x)[2]] %in% c(temporal,spatial))),drop=FALSE] + + if (sum(!(colnames(x)[-dim(x)[2]] %in% c(temporal, spatial))) > 1) { + d <- .collapsecol(x, which(!(colnames(x)[-dim(x)[2]] %in% c(temporal, spatial))), sep) + } else if (sum(!(colnames(x)[-dim(x)[2]] %in% c(temporal, spatial))) == 1) { + d <- x[, which(!(colnames(x)[-dim(x)[2]] %in% c(temporal, spatial))), drop = FALSE] } else { - d <- data.frame(data=rep(tail(colnames(x),1),dim(x)[1])) + d <- data.frame(data = rep(tail(colnames(x), 1), dim(x)[1])) } d[[1]] <- as.character(d[[1]]) - - u_spat <- as.character(unique(s[,1])) - u_temp <- as.character(unique(t[,1])) - u_data <- as.character(unique(d[,1])) - dimnames <- list(u_spat,u_temp,u_data) - m <- array(dim=c(length(u_spat),length(u_temp),length(u_data)),dimnames=dimnames) - coord <- as.matrix(cbind(s,t,d)) + + uSpat <- as.character(unique(s[, 1])) + uTemp <- as.character(unique(t[, 1])) + uData <- as.character(unique(d[, 1])) + dimnames <- list(uSpat, uTemp, uData) + m <- array(dim = c(length(uSpat), length(uTemp), length(uData)), dimnames = dimnames) + coord <- as.matrix(cbind(s, t, d)) .duplicates_check(coord) - m[coord] <- x[,dim(x)[2]] - if(dim(m)[2]==1) if(dimnames(m)[[2]]=="NOTIME") dimnames(m) <- list(dimnames(m)[[1]],NULL,dimnames(m)[[3]]) - if(dim(m)[3]==1) if(dimnames(m)[[3]]=="NODATA") dimnames(m) <- list(dimnames(m)[[1]],dimnames(m)[[2]],NULL) - - names(dimnames(m)) <- c(names(s),names(t),names(d)) - m <- as.magpie(m,spatial=1,temporal=2) - return(copy.attributes(x,m)) -} \ No newline at end of file + m[coord] <- x[, dim(x)[2]] + if (dim(m)[2] == 1) if (dimnames(m)[[2]] == "NOTIME") dimnames(m) <- list(dimnames(m)[[1]], NULL, dimnames(m)[[3]]) + if (dim(m)[3] == 1) if (dimnames(m)[[3]] == "NODATA") dimnames(m) <- list(dimnames(m)[[1]], dimnames(m)[[2]], NULL) + + names(dimnames(m)) <- c(names(s), names(t), names(d)) + m <- as.magpie(m, spatial = 1, temporal = 2) + return(copy.attributes(x, m)) +} diff --git a/README.md b/README.md index d3ac135b..c566ccec 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Data Class and Tools for Handling Spatial-Temporal Data -R package **magclass**, version **6.0.5** +R package **magclass**, version **6.0.6** [![CRAN status](https://www.r-pkg.org/badges/version/magclass)](https://cran.r-project.org/package=magclass) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158580.svg)](https://doi.org/10.5281/zenodo.1158580) [![R build status](https://github.com/pik-piam/magclass/workflows/check/badge.svg)](https://github.com/pik-piam/magclass/actions) [![codecov](https://codecov.io/gh/pik-piam/magclass/branch/master/graph/badge.svg)](https://codecov.io/gh/pik-piam/magclass) [![r-universe](https://pik-piam.r-universe.dev/badges/magclass)](https://pik-piam.r-universe.dev/ui#builds) @@ -55,7 +55,7 @@ In case of questions / problems please contact Jan Philipp Dietrich . +Dietrich J, Bodirsky B, Bonsch M, Humpenoeder F, Bi S, Karstens K, Leip D (2021). _magclass: Data Class and Tools for Handling Spatial-Temporal Data_. doi: 10.5281/zenodo.1158580 (URL: https://doi.org/10.5281/zenodo.1158580), R package version 6.0.6, . A BibTeX entry for LaTeX users is @@ -64,7 +64,7 @@ A BibTeX entry for LaTeX users is title = {magclass: Data Class and Tools for Handling Spatial-Temporal Data}, author = {Jan Philipp Dietrich and Benjamin Leon Bodirsky and Markus Bonsch and Florian Humpenoeder and Stephen Bi and Kristine Karstens and Debbora Leip}, year = {2021}, - note = {R package version 6.0.5}, + note = {R package version 6.0.6}, doi = {10.5281/zenodo.1158580}, url = {https://github.com/pik-piam/magclass}, } diff --git a/tests/testthat/test-as.magpie.R b/tests/testthat/test-as.magpie.R index 0eb3c83a..802498d0 100644 --- a/tests/testthat/test-as.magpie.R +++ b/tests/testthat/test-as.magpie.R @@ -33,6 +33,15 @@ test_that("special cases work", { m2 <- as.magpie(a) expect_equal(unname(getSets(m2)), attr(a, "sets")) + bla <- data.frame(from = c("bla", "blub"), to = c("ble", "blo"), stringsAsFactors = FALSE) + bla2 <- data.frame(from = c("bla", "blub"), to = c("ble", "blo"), stringsAsFactors = TRUE) + blaExpect <- new("magpie", + .Data = structure(c("ble", "blo"), + .Dim = c(1L, 1L, 2L), + .Dimnames = list(region = "GLO", year = NULL, + from = c("bla", "blub")))) + expect_identical(as.magpie(bla), blaExpect) + expect_identical(as.magpie(bla2), blaExpect) }) test_that("underscores are preserved", {