Merge pull request #98 from orichters/growthrate

add reportDuplicates() function

.buildlibrary

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

.pre-commit-config.yaml

@@ -15,7 +15,7 @@ repos:
     -   id: mixed-line-ending
 
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: 7910e0323d7213f34275a7a562b9ef0fde8ce1b9  # frozen: v0.4.2
+    rev: bae853d82da476eee0e0a57960ee6b741a3b3fb7  # frozen: v0.4.3
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

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.3136.0
-date-released: '2024-08-15'
+version: 0.3137.1
+date-released: '2024-08-19'
 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.3136.0
-Date: 2024-08-15
+Version: 0.3137.1
+Date: 2024-08-19
 Authors@R: c(
     person("Michaja", "Pehl", , "[email protected]", role = c("aut", "cre")),
     person("Nico", "Bauer", , "[email protected]", role = "aut"),

NAMESPACE

@@ -76,6 +76,7 @@ export(read_mif_header)
 export(removeColNa)
 export(replace_column)
 export(replace_column_)
+export(reportDuplicates)
 export(revalue.levels)
 export(revalue.levels_)
 export(seq_range)

R/calc_growthrate.R

@@ -1,8 +1,9 @@
 #' Calculates the growth rate in '%/yr' for variables
 #'
 #' @param x anything with an as.quitte method (data.frame, quitte or magclass object, mif file, ...)
-#' @param only.new If `FALSE` (the default), add new variables to existing
-#'   ones.  If `TRUE`, return only new variables.
+#' @param only.new If `FALSE` (the default), add new variables to existing ones.
+#'   If variable names already exist in the data.frame, they are replaced.
+#'   If `TRUE`, return only new variables.
 #' @param filter.function A function used to filter data before calculating growth rates.
 #'   If instead a character vector is passed, only variables matching this vector are used.
 #'
@@ -52,6 +53,6 @@ calc_growthrate <- function(x, only.new = FALSE, filter.function = identity) {
   if (isTRUE(only.new)) {
     return(xg)
   } else {
-    return(rbind(x, xg))
+    return(rbind(filter(x, ! .data$variable %in% levels(xg$variable)), xg))
   }
 }

R/read.quitte.R

@@ -238,12 +238,7 @@ read.quitte <- function(file,
 
     # check for duplicate entries, ignoring values
     if (check.duplicates) {
-        distinct_rows <- quitte %>%
-            select(-'value') %>%
-            distinct() %>%
-            nrow()
-        if (nrow(quitte) != distinct_rows)
-            warning('Duplicates in resulting quitte')
+        reportDuplicates(quitte, action = "warn")
     }
 
     # apply quitte "class" attribute

R/reportDuplicates.R

@@ -0,0 +1,34 @@
+#' Checks for duplicates in quitte object
+#'
+#' Finds duplicates in a quitte object and warns about them per model and scenario.
+#' Also warn if variables are identical but value or units differ.
+#'
+#' @param mifdata object that can be converted with as.quitte
+#' @param action if set to 'warn', a warning with duplicate variables is raised
+#' @importFrom dplyr filter mutate select
+#' @return only the data that is duplicated. Has 0 rows if everything is fine
+#' @export
+reportDuplicates <- function(mifdata, action = "warn") {
+  mifdata <- as.quitte(mifdata)
+  duplicates <- mifdata %>%
+    group_by(!!!syms(setdiff(colnames(mifdata), c("unit", "value")))) %>%
+    filter(n() > 1) %>%
+    ungroup() %>%
+    droplevels() %>%
+    quitteSort()
+  if (nrow(duplicates) > 0 && isTRUE(action == "warn")) {
+    warning(paste(c(
+      "Duplicated data found for:",
+      duplicates %>%
+        distinct(.data$model, .data$scenario, .data$variable, .data$unit) %>%
+        group_by(.data$model, .data$scenario) %>%
+        summarise(
+          text = paste0(
+            unique(.data$model), " ", unique(.data$scenario), ": ",
+            paste0(.data$variable, " (", .data$unit, ")", collapse = ", ")),
+          .groups = 'drop') %>%
+        pull('text')),
+      collapse = '\n  '))
+  }
+  return(invisible(duplicates))
+}

README.md

@@ -1,6 +1,6 @@
 # Bits and pieces of code to use with quitte-style data frames
 
-R package **quitte**, version **0.3136.0**
+R package **quitte**, version **0.3137.1**
 
 [![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 (2024). _quitte: Bits and pieces of code to use with quitte-style data frames_. R package version 0.3136.0, <https://github.com/pik-piam/quitte>.
+Pehl M, Bauer N, Hilaire J, Levesque A, Luderer G, Schultes A, Dietrich J, Richters O (2024). _quitte: Bits and pieces of code to use with quitte-style data frames_. R package version 0.3137.1, <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 = {2024},
-  note = {R package version 0.3136.0},
+  note = {R package version 0.3137.1},
   url = {https://github.com/pik-piam/quitte},
 }
 ```

tests/testthat/test-read.quitte.R

@@ -29,6 +29,15 @@ test_that(
                    regexp = NA)
   })
 
+test_that(
+  'warning raised in case of duplicates',
+  {
+    expect_warning(object = read.quitte(rep(system.file('extdata',
+                                                        'extra_column.mif',
+                                                        package = 'quitte'), 2)),
+                   regexp = "Duplicated data found for")
+  })
+
 # read .mif file with comment header ----
 test_that(
   desc = 'read .mif file with comment header',

tests/testthat/test-reportDuplicates.R

@@ -0,0 +1,31 @@
+test_that("report duplicate works", {
+  # really identical
+  d <- data.frame(variable = "Emi", unit = "Mt CO2/yr", period = c(2020, 2020), value = 1)
+  expect_warning(dupl <- reportDuplicates(d),
+                 "Emi")
+  expect_true(nrow(dupl) > 0)
+  # difference in unit only
+  d <- data.frame(variable = "Emi", unit = c("Mt CO2/yr", "kt CO2/yr"), period = 2020, value = 1)
+  expect_warning(dupl <- reportDuplicates(d),
+                 "Emi")
+  expect_true(nrow(dupl) > 0)
+  # difference in value and unit
+  d <- data.frame(variable = "Emi", unit = c("Mt CO2/yr", "kt CO2/yr"), period = 2020, value = c(1, 2))
+  expect_warning(dupl <- reportDuplicates(d),
+                 "Emi")
+  expect_true(nrow(dupl) > 0)
+  # differs by variant is acceptable
+  d <- data.frame(variable = "Emi", unit = "Mt CO2/yr", period = 2020,
+                  variant = c('A', 'B'), value = 1)
+  expect_no_warning(dupl <- reportDuplicates(d))
+  expect_true(nrow(dupl) == 0)
+  # everything fine
+  d <- data.frame(variable = "Emi", unit = "Mt CO2/yr", period = 2020, value = 1)
+  expect_no_warning(dupl <- reportDuplicates(d))
+  expect_true(nrow(dupl) == 0)
+  # everything fine with exampledata
+  expect_no_warning(dupl <- reportDuplicates(quitte_example_data))
+  expect_true(nrow(dupl) == 0)
+  expect_no_warning(dupl <- reportDuplicates(quitte_example_dataAR6))
+  expect_true(nrow(dupl) == 0)
+})