Merge pull request #69 from orichters/smallfix

add quitteSort to get consistent sorting

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '612505180'
+ValidationKey: '613325970'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

CITATION.cff

@@ -2,8 +2,8 @@ cff-version: 1.2.0
 message: If you use this software, please cite it using the metadata from this file.
 type: software
 title: 'quitte: Bits and pieces of code to use with quitte-style data frames'
-version: 0.3122.0
-date-released: '2023-09-19'
+version: 0.3123.0
+date-released: '2023-10-09'
 abstract: A collection of functions for easily dealing with quitte-style data frames,
   doing multi-model comparisons and plots.
 authors:

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: quitte
 Title: Bits and pieces of code to use with quitte-style data frames
-Version: 0.3122.0
-Date: 2023-09-19
+Version: 0.3123.0
+Date: 2023-10-09
 Authors@R: c(
     person("Michaja", "Pehl", , "[email protected]", role = c("aut", "cre")),
     person("Nico", "Bauer", , "[email protected]", role = "aut"),

NAMESPACE

@@ -65,6 +65,7 @@ export(order.levels_)
 export(overwrite)
 export(prepQuitteForScatter)
 export(quitte2quantiles)
+export(quitteSort)
 export(read.gdx)
 export(read.quitte)
 export(removeColNa)
@@ -86,6 +87,7 @@ import(dplyr)
 import(utils)
 importFrom(countrycode,countrycode)
 importFrom(dplyr,anti_join)
+importFrom(dplyr,arrange)
 importFrom(dplyr,as_tibble)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,distinct)

R/as.quitte.R

@@ -17,6 +17,7 @@
 #' @param na.rm if set to TRUE entries with value NA will be removed
 #' @author Jan Philipp Dietrich
 #' @keywords classes
+#' @importFrom dplyr bind_rows relocate
 #' @importFrom forcats fct_na_value_to_level
 #' @importFrom magclass clean_magpie getNames getNames<- getSets getSets<-
 #' @importFrom reshape2 melt
@@ -41,10 +42,11 @@ as.quitte.character <- function(x, periodClass = "integer", addNA = FALSE, na.rm
 #' @method as.quitte quitte
 #' @export
 as.quitte.quitte <- function(x, periodClass = "integer", addNA = FALSE, na.rm = FALSE) { # nolint
+    model <- scenario <- region <- variable <- unit <- period <- NULL
     if (is.quitte(x, warn = FALSE)) {
         if (addNA) x <- qaddNA(x)
         if (na.rm) x <- x[!is.na(x$value), ]
-        return(x)
+        return(relocate(x, model, scenario, region, variable, unit, period))
     } else {
         class(x) <- class(x)[class(x) != "quitte"]
         return(as.quitte.data.frame(x, periodClass = periodClass, addNA = addNA, na.rm = na.rm))
@@ -233,11 +235,7 @@ as.quitte.magpie <- function(x, periodClass = "integer", addNA = FALSE, na.rm =
 #' @method as.quitte list
 #' @export
 as.quitte.list <- function(x, periodClass = "integer", addNA = FALSE, na.rm = FALSE) { # nolint
-    out <- NULL
-    for (xi in x) {
-      out <- rbind(out, as.quitte(xi, periodClass = periodClass, addNA = addNA, na.rm = na.rm))
-    }
-    return(out)
+    return(bind_rows(lapply(x, as.quitte, periodClass = periodClass, addNA = addNA, na.rm = na.rm)))
 }
 
 qaddNA <- function(x) {

R/quitteSort.R

@@ -0,0 +1,18 @@
+#' Sorts a quitte object in a standardized way:
+#' model -> scenario -> variable -> unit -> region -> period
+#'
+#' @param x A quitte object
+#'
+#' @author Oliver Richters
+#'
+#' @importFrom dplyr arrange relocate
+#'
+#' @return the sorted quitte object
+#' @export
+quitteSort <- function(x) {
+  model <- scenario <- region <- variable <- unit <- period <- NULL
+  x <- as.quitte(x) %>%
+    relocate(model, scenario, region, variable, unit, period) %>%
+    arrange(model, scenario, variable, unit, region, period) %>%
+    return()
+}

README.md

@@ -1,6 +1,6 @@
 # Bits and pieces of code to use with quitte-style data frames
 
-R package **quitte**, version **0.3122.0**
+R package **quitte**, version **0.3123.0**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/quitte)](https://cran.r-project.org/package=quitte)  [![R build status](https://github.com/pik-piam/quitte/workflows/check/badge.svg)](https://github.com/pik-piam/quitte/actions) [![codecov](https://codecov.io/gh/pik-piam/quitte/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/quitte) [![r-universe](https://pik-piam.r-universe.dev/badges/quitte)](https://pik-piam.r-universe.dev/builds)
 
@@ -47,7 +47,7 @@ In case of questions / problems please contact Michaja Pehl <michaja.pehl@pik-po
 
 To cite package **quitte** in publications use:
 
-Pehl M, Bauer N, Hilaire J, Levesque A, Luderer G, Schultes A, Dietrich J, Richters O (2023). _quitte: Bits and pieces of code to use with quitte-style data frames_. R package version 0.3122.0, <URL: https://github.com/pik-piam/quitte>.
+Pehl M, Bauer N, Hilaire J, Levesque A, Luderer G, Schultes A, Dietrich J, Richters O (2023). _quitte: Bits and pieces of code to use with quitte-style data frames_. R package version 0.3123.0, <URL: https://github.com/pik-piam/quitte>.
 
 A BibTeX entry for LaTeX users is
 
@@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is
   title = {quitte: Bits and pieces of code to use with quitte-style data frames},
   author = {Michaja Pehl and Nico Bauer and Jérôme Hilaire and Antoine Levesque and Gunnar Luderer and Anselm Schultes and Jan Philipp Dietrich and Oliver Richters},
   year = {2023},
-  note = {R package version 0.3122.0},
+  note = {R package version 0.3123.0},
   url = {https://github.com/pik-piam/quitte},
 }
 ```

tests/testthat/test-as.quitte.R

@@ -76,7 +76,7 @@ test_that(
 )
 
 test_that(
-  'as.quitte understands lists()',
+  'as.quitte understands lists',
   {
     expect_identical(quitte_example_data, as.quitte(list(list(quitte_example_data))))
     miffile <- tempfile(fileext = ".mif")

tests/testthat/test-quitteSort.R

@@ -0,0 +1,23 @@
+context('quitteSort()')
+
+test_that('quitteSort works', {
+  for (qe in list(quitte_example_dataAR6, quitte_example_data)) {
+    qe <- droplevels(as.quitte(qe, na.rm = TRUE))
+    qes <- droplevels(quitteSort(qe))
+    for (type in colnames(qe)) {
+      expect_equal(sort(unique_or_levels(qe[[type]])), sort(unique_or_levels(qes[[type]])))
+    }
+    expect_identical(nrow(qe), nrow(qes))
+    # move model column to the end
+    qewrong <- relocate(qes, model, .after = value)
+    expect_false(identical(qes, qewrong))
+    expect_identical(qes, quitteSort(qewrong))
+    # move first region to the end
+    qewrong <- bind_rows(
+          qes %>% filter(first(region) != region),
+          qes %>% filter(first(region) == region)
+    )
+    expect_false(identical(qes, qewrong))
+    expect_identical(qes, quitteSort(qewrong))
+  }
+})