Merge pull request #105 from tscheypidi/master

bugfix in tidy2magpie for proper treatment of factor values

.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'

.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": "<p>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": [
     {

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 = "[email protected]", role = c("aut","cre")),
              person("Benjamin Leon", "Bodirsky", email = "[email protected]", role = "aut"),
              person("Markus", "Bonsch", role = "aut"),

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))
-}
+  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))
+}

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@pi
 
 To cite package **magclass** in publications use:
 
-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.5, <URL: https://github.com/pik-piam/magclass>.
+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, <URL: https://github.com/pik-piam/magclass>.
 
 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},
 }

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", {