add is_quitte()

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '613522360'
+ValidationKey: '613812500'
 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.3124.0
-date-released: '2023-10-09'
+version: 0.3125.0
+date-released: '2023-10-12'
 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.3124.0
-Date: 2023-10-09
+Version: 0.3125.0
+Date: 2023-10-12
 Authors@R: c(
     person("Michaja", "Pehl", , "[email protected]", role = c("aut", "cre")),
     person("Nico", "Bauer", , "[email protected]", role = "aut"),

NAMESPACE

@@ -54,6 +54,7 @@ export(inline.data.frame)
 export(interpolate_missing_periods)
 export(interpolate_missing_periods_)
 export(is.quitte)
+export(is_quitte)
 export(list_to_data_frame)
 export(list_to_data_frame_)
 export(madrat_mule)

R/is_quitte.R

@@ -0,0 +1,102 @@
+#' Does a data frame conform to the quitte "standard"?
+#'
+#' @md
+#' @param x An object to be tested.
+#' @param verbose If `TRUE`, prints why `x` is not a `quitte` data frame.
+#'     Intended for interactive use.
+#'
+#' @return `TRUE` if `x` conforms to the quitte "standard", `FALSE` otherwise.
+#'     If `verbose` is `TRUE`, returns invisibly.
+#'
+#' @examples
+#' library(dplyr)
+#'
+#' is_quitte(quitte_example_data)
+#' is_quitte(quitte_example_data %>% mutate(period = is.numeric(period)),
+#'           verbose = TRUE)
+#' is_quitte(quitte_example_data %>% select(-unit), verbose = TRUE)
+
+#' @export
+is_quitte <- function(x, verbose = FALSE) {
+    if (!is.data.frame(x)) {
+        if (isTRUE(verbose)) {
+            message('`x` is not a data frame.')
+            return(invisible(FALSE))
+        }
+        else {
+            return(FALSE)
+        }
+    }
+
+    required_columns <- list('model'    = c('character', 'factor'),
+                             'scenario' = c('character', 'factor'),
+                             'region'   = c('character', 'factor'),
+                             'variable' = c('character', 'factor'),
+                             'unit'     = c('character', 'factor'),
+                             'period'   = c('integer', 'POSIXct'),
+                             'value'    = 'numeric')
+
+    .is_quitte <- TRUE
+
+    # check column existence ----
+    missing_columns <- !names(required_columns) %in% colnames(x)
+    if (any(missing_columns)) {
+        if (isTRUE(verbose)) {
+            message(
+                'Column', ifelse(sum(missing_columns) - 1, 's ', ' '),
+                paste(
+                    paste0('`', names(required_columns)[missing_columns], '`'),
+                    collapse = ', '),
+                ifelse(sum(missing_columns) > 1, ' are ', ' is '),
+                'missing in `x`')
+
+            .is_quitte <- FALSE
+        }
+        else {
+            return(FALSE)
+        }
+    }
+
+    # check column classes ----
+    column_classes <- x %>%
+        select(any_of(names(required_columns))) %>%
+        sapply(class)
+
+    wrong_column_classes <- sapply(
+        seq_along(column_classes),
+        function(i) {
+            !any(column_classes[[i]] %in%
+                     required_columns[[names(column_classes)[[i]]]])
+        }) %>%
+        setNames(column_classes)
+
+    if (any(wrong_column_classes)) {
+        if (isTRUE(verbose)) {
+            message(
+                'Wrong column class',
+                ifelse(sum(wrong_column_classes) > 1, 'es', ''), ':\n',
+                paste(
+                    paste0(
+                        '  ',
+                        names(column_classes[which(wrong_column_classes)]),
+                        ' [', column_classes[which(wrong_column_classes)],
+                        '], not ',
+                        required_columns[
+                            names(column_classes[wrong_column_classes])]
+                    ),
+                    collapse = '\n'))
+
+            .is_quitte <- FALSE
+        }
+        else {
+            return(FALSE)
+        }
+    }
+
+    if (isTRUE(verbose)) {
+        return(invisible(.is_quitte))
+    }
+    else {
+        return(.is_quitte)
+    }
+}

README.md

@@ -1,6 +1,6 @@
 # Bits and pieces of code to use with quitte-style data frames
 
-R package **quitte**, version **0.3124.0**
+R package **quitte**, version **0.3125.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.3124.0, <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.3125.0, <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.3124.0},
+  note = {R package version 0.3125.0},
   url = {https://github.com/pik-piam/quitte},
 }
 ```

tests/testthat/test-is_quitte.R

@@ -0,0 +1,50 @@
+# test column existence ----
+test_that(
+  desc = 'is_quitte() returns FALSE on missing columns',
+  code = {
+    for (col in colnames(quitte_example_data))
+      expect_false(
+        is_quitte(select(quitte_example_data, -all_of(col))))
+  }
+)
+
+# test additional columns ----
+test_that(
+  desc = 'is_quitte() returns TRUE on additional columns',
+  code = {
+    expect_true(is_quitte(quitte_example_data %>% mutate(foo = n())))
+  }
+)
+
+# test wrong column classes ----
+test_that(
+  desc = 'is_quitte() returns FALSE on wrong column classes',
+  code = {
+    x <- quitte_example_data %>%
+      factor.data.frame()
+    for (col in colnames(quitte_example_data)) {
+      if (col %in% c('model', 'scenario', 'region', 'variable', 'unit')) {
+        expect_false(
+          is_quitte(mutate(x, !!sym(col) := as.integer(.data[[col]]))))
+      }
+      else if ('period' == col) {
+        expect_false(is_quitte(mutate(x, period = is.numeric(x[['period']]))))
+      }
+      else {
+        expect_false(is_quitte(mutate(x, value = as.character(x[['value']]))))
+      }
+    }
+  }
+)
+
+# test correct column classes ----
+test_that(
+  desc = 'is_quitte() returns TRUE on correct column classes',
+  code = {
+    expect_true(is_quitte(quitte_example_data %>% factor.data.frame()))
+    expect_true(is_quitte(quitte_example_data %>% character.data.frame()))
+    expect_true(
+      is_quitte(quitte_example_data %>%
+                  mutate(period = ISOyear(.data[['period']]))))
+      }
+)