Merge pull request #9 from beniaminogreen/ruleset_construction

Feature request: Add `+` for rulesets

DESCRIPTION

@@ -6,7 +6,12 @@ Authors@R: c(
       person(given = "David",
              family = "Zimmermann-Kollenda",
              role = c("aut","cre"),
-             email = "[email protected]"))
+             email = "[email protected]"),
+      person(given = "Beniamino",
+             family = "Green",
+             role = "ctb",
+             email = "[email protected]")
+      )
 Description: Allows you to define rules which can be used to verify a given
     dataset.
     The package acts as a thin wrapper around more powerful data packages such
@@ -15,9 +20,9 @@ License: MIT + file LICENSE
 URL: https://github.com/DavZim/dataverifyr,
     https://davzim.github.io/dataverifyr/
 BugReports: https://github.com/DavZim/dataverifyr/issues
-Imports: 
+Imports:
     yaml
-Suggests: 
+Suggests:
     arrow,
     data.table,
     DBI,

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("+",rule)
+S3method("+",ruleset)
 S3method(print,rule)
 S3method(print,ruleset)
 export(check_data)

R/ruleset_construction.R

@@ -0,0 +1,52 @@
+#' Add Rules and Rulesets Together
+#'
+#' @description + allows you to add rules and rulesets into larger rulesets. This
+#' can be useful if you want to create a ruleset for a dataset out of checks
+#' for other datasets.
+#' @param a the first ruleset you wish to add
+#' @param b the second ruleset you wish to add
+#' @name dataverifyr_plus
+datavarifyr_plus <- function(a, b) {
+  # This is the method to add *both* rules and rulesets together.
+  # Has to be done this way AFAIK to comply with R's
+  # [double dispatch](https://yutani.rbind.io/post/double-dispatch-of-s3-method/)
+  # semantics.
+
+  if (inherits(a, "rule")  & inherits(b, "rule")) {
+    out <- list(a, b)
+  } else {
+    if (inherits(a, "rule")) a <- list(a)
+    if (inherits(b,"rule")) b <- list(b)
+    out <- c(a, b)
+  }
+
+  out <- out[!duplicated(out)]
+
+  for (i in seq_along(out)) {
+    out[[i]]["index"] <- i
+  }
+
+  class(out) <- "ruleset"
+  return(out)
+}
+
+#' @export
+#' @rdname dataverifyr_plus
+"+.ruleset" <- datavarifyr_plus
+
+#' @export
+#' @rdname dataverifyr_plus
+"+.rule" <- datavarifyr_plus
+
+
+###############################################################################
+
+#' Programatically Combine a List of Rules and Rulesets into a Single Ruleset
+#'
+#' @param rule_ruleset_list a list of rules and rulesets you whish to combine
+#' into a single list
+#'
+#' @return a ruleset which consolidates all the inputs
+bind_rules <- function(rule_ruleset_list) {
+  Reduce(`+`, rule_ruleset_list)
+}

tests/testthat/test-ruleset_construction.R

@@ -0,0 +1,78 @@
+test_that("Rules can be added together", {
+      rule_1 <- rule(mpg > 10)
+      rule_2 <- rule(hp > 10)
+      expect_equal(
+        rule_1 + rule_2,
+        ruleset(rule_1, rule_2)
+      )
+})
+
+test_that("Rules can be added to rulesets", {
+      rule_1 <- rule(mpg > 10)
+      rule_2 <- rule(hp > 10)
+      rule_3 <- rule(name == "henry")
+
+      expect_equal(
+        rule_1 + ruleset(rule_2, rule_3),
+        ruleset(rule_1, rule_2, rule_3)
+      )
+})
+
+test_that("rulesets can be added to rules", {
+      rule_1 <- rule(mpg > 10)
+      rule_2 <- rule(hp > 10)
+      rule_3 <- rule(name == "henry")
+
+      expect_equal(
+        ruleset(rule_1, rule_2) + rule_3,
+        ruleset(rule_1, rule_2, rule_3)
+      )
+})
+
+test_that("rulesets can be added to rules", {
+      rule_1 <- rule(mpg > 10)
+      rule_2 <- rule(hp > 10)
+      rule_3 <- rule(name == "henry")
+      rule_4 <- rule(sex == "female")
+
+      expect_equal(
+        ruleset(rule_1, rule_2) + ruleset(rule_3, rule_4),
+        ruleset(rule_1, rule_2, rule_3, rule_4)
+      )
+})
+
+test_that("duplicates are removed when adding rules and rulesets", {
+      rule_1 <- rule(mpg > 10)
+      rule_2 <- rule(hp > 10)
+      expect_equal(
+        length(ruleset(rule_1, rule_2) + ruleset(rule_1, rule_2)),
+        2
+      )
+
+      expect_equal(
+        length(rule_1 + rule_2 + ruleset(rule_1, rule_2) + ruleset(rule_1, rule_2)),
+        2
+      )
+})
+
+test_that("bind_rules works", {
+      rule_1 <- rule(mpg > 10)
+      rule_2 <- rule(hp > 10)
+      rule_3 <- rule(name == "henry")
+      rule_4 <- rule(sex == "female")
+
+      expect_equal(
+        bind_rules(list(rule_1, rule_2, ruleset(rule_3, rule_4))),
+        ruleset(rule_1, rule_2, rule_3, rule_4)
+      )
+
+      expect_equal(
+        bind_rules(list(ruleset(rule_1, rule_2), ruleset(rule_3, rule_4))),
+        ruleset(rule_1, rule_2, rule_3, rule_4)
+      )
+
+      expect_equal(
+        bind_rules(list(rule_1, ruleset(rule_2), ruleset(rule_3, rule_4))),
+        ruleset(rule_1, rule_2, rule_3, rule_4)
+      )
+})