Hierarchical metadata@main

NAMESPACE

@@ -21,6 +21,8 @@ export(assert_valid_list_format)
 export(attr_label)
 export(attr_label_df)
 export(co_relevels)
+export(combineListRules)
+export(combine_rules)
 export(cut_by_group)
 export(get_arg)
 export(get_log)

NEWS.md

@@ -2,6 +2,7 @@
 
 * Rules specified under the `all_datasets` keyword in a format list will apply to every data set of the reformatted object unless specified otherwise.
 * New `verbose` argument in the `reformat` method. When applied to `list` the value of this augment can be controlled with the `dunlin.reformat.verbose` option or the `R_DUNLIN_REFORMAT_VERBOSE` environment variable.
+* New `combine_rules` and `combineListRules.Rd` functions to combine rules or list of rules into a single rule or a single list of rules.
 
 # dunlin 0.1.6
 

R/rules.R

@@ -120,3 +120,96 @@ as.list.rule <- function(x, ...) {
 
   r_list
 }
+
+#' Combine Two Rules
+#'
+#' @param x (`rule`) to modify.
+#' @param y (`rule`) rule whose mapping will take precedence over the ones described in `x`.
+#' @param safe (`flag`) whether to throw an error if both rules are `NULL`. Otherwise return the empty rule: `rule()`.
+#' @param ... not used.
+#'
+#' @note The order of the mappings in the resulting rule corresponds to the order of the mappings in `y` followed by the
+#'  mappings in `x`.
+#'
+#' @returns a `rule`.
+#' @export
+#' @examples
+#' r1 <- rule(
+#'   "first" = c("from ori rule", "FROM ORI RULE"),
+#'   "last" = c(NA, "last"),
+#'   .to_NA = "X",
+#'   .drop = TRUE
+#' )
+#' r2 <- rule(
+#'   "first" = c("F", "f"),
+#'   "second" = c("S", "s"),
+#'   "third" = c("T", "t"),
+#'   .to_NA = "something"
+#' )
+#' combine_rules(r1, r2)
+combine_rules <- function(x, y, safe = TRUE, ...) {
+  checkmate::assert_class(x, "rule", null.ok = TRUE)
+  checkmate::assert_class(y, "rule", null.ok = TRUE)
+  checkmate::assert_flag(safe)
+
+  if (is.null(x) && is.null(y) && safe) {
+    rlang::abort("Both rules are NULL.")
+  }
+
+  # If one of the rules is NULL, return the other (via empty list).
+  x <- as.list(x)
+  y <- as.list(y)
+  names_y <- names(y)
+  names_x <- setdiff(names(x), names(y))
+
+  x <- x[names_x]
+  r <- c(y, x)
+  r <- do.call(rule, r)
+  r
+}
+
+#' Combine Rules Found in Lists of Rules.
+#'
+#' @param x (`list`) of `rule` objects.
+#' @param val (`list`) of `rule` objects.
+#' @param ... passed to `combine_rules`.
+#'
+#' @returns a `list` of `rule` objects.
+#' @export
+#' @examples
+#' l1 <- list(
+#'   r1 = rule(
+#'     "first" = c("from ori rule", "FROM ORI RULE"),
+#'     "last" = c(NA, "last")
+#'   ),
+#'   r2 = rule(
+#'     ANYTHING = "anything"
+#'   )
+#' )
+#'
+#' l2 <- list(
+#'   r1 = rule(
+#'     "first" = c("F", "f"),
+#'     "second" = c("S", "s"),
+#'     "third" = c("T", "t"),
+#'     .to_NA = "something"
+#'   ),
+#'   r3 = rule(
+#'     SOMETHING = "something"
+#'   )
+#' )
+#'
+#' combineListRules(l1, l2)
+combineListRules <- function(x, val, ...) {
+  checkmate::assert_list(x, types = "rule", null.ok = FALSE, names = "unique")
+  checkmate::assert_list(val, types = "rule", null.ok = FALSE, names = "unique")
+
+  xnames <- names(x)
+  vnames <- names(val)
+  vnames <- vnames[nzchar(vnames)]
+
+  for (v in vnames) {
+    x[[v]] <- combine_rules(x[[v]], val[[v]], ...)
+  }
+  x
+}

_pkgdown.yaml

@@ -47,6 +47,8 @@ reference:
       - rule
       - as.list.rule
       - list2rules
+      - combine_rules
+      - combineListRules
   - title: Filtering
     contents:
       - log_filter

tests/testthat/test-rules.R

@@ -116,3 +116,115 @@ test_that("as.list and rule are reversible when .to_NA is NULL", {
   test_rule <- rule(a = c("a", "b"), b = c("c", "d"), .drop = FALSE, .na_last = TRUE, .to_NA = NULL)
   expect_identical(do.call(rule, as.list(test_rule)), test_rule)
 })
+
+# combine_rules ----
+
+test_that("combine_rules works as expected", {
+  r1 <- rule(a = "1", b = "2", .to_NA = "x", .drop = TRUE, .na_last = FALSE)
+  r2 <- rule(a = "3", c = "4", .to_NA = "y", .drop = FALSE)
+
+  res <- combine_rules(r1, r2)
+  expect_s3_class(res, "rule")
+  expect_identical(res, rule(a = "3", c = "4", b = "2", .to_NA = "y", .drop = FALSE, .na_last = TRUE))
+})
+
+test_that("combine_rules works as expected with `NULL` values", {
+  r1 <- NULL
+  r2 <- rule(a = "3", c = "4", .to_NA = "y")
+
+  res <- combine_rules(r1, r2)
+  expect_s3_class(res, "rule")
+  expect_identical(res, r2)
+})
+
+test_that("combine_rules works as expected with `NULL` values", {
+  r1 <- rule(a = "1", b = "2", .to_NA = "x", .drop = TRUE, .na_last = FALSE)
+  r2 <- NULL
+
+  res <- combine_rules(r1, r2)
+  expect_s3_class(res, "rule")
+  expect_identical(res, r1)
+})
+
+test_that("combine_rules works as expected when both rules are `NULL` values", {
+  r1 <- NULL
+  r2 <- NULL
+  expect_error(combine_rules(r1, r2), "Both rules are NULL.")
+
+  res <- combine_rules(r1, r2, safe = FALSE)
+  expect_s3_class(res, "rule")
+  expect_identical(res, rule())
+})
+
+# combineListRules ----
+
+test_that("combineListRules works as expected", {
+  l1 <- list(
+    r1 = rule(
+      "first" = c("will be overwritten", "WILL BE OVERWRITTEN"),
+      "last" = c(NA, "last")
+    ),
+    r2 = rule(
+      ANYTHING = "anything"
+    )
+  )
+
+  l2 <- list(
+    r1 = rule(
+      "first" = c("F", "f"),
+      "second" = c("S", "s"),
+      "third" = c("T", "t"),
+      .to_NA = "something"
+    ),
+    r3 = rule(
+      SOMETHING = "something"
+    )
+  )
+
+  res <- combineListRules(l1, l2)
+  checkmate::expect_list(res, types = "rule", len = 3, names = "named")
+  expect_identical(names(res), c("r1", "r2", "r3"))
+
+  expect_identical(
+    res$r1,
+    rule(
+      "first" = c("F", "f"),
+      "second" = c("S", "s"),
+      "third" = c("T", "t"),
+      "last" = c(NA, "last"),
+      .to_NA = "something"
+    )
+  )
+
+  expect_identical(
+    res$r2,
+    rule(
+      ANYTHING = "anything"
+    )
+  )
+
+  expect_identical(
+    res$r3,
+    rule(
+      SOMETHING = "something"
+    )
+  )
+})
+
+
+test_that("combineListRules fails as expected when elements are not rules", {
+  l1 <- list(
+    r1 = NULL
+  )
+
+  l2 <- list(
+    r1 = rule(
+      "first" = c("F", "f"),
+      "second" = c("S", "s"),
+      "third" = c("T", "t"),
+      .to_NA = "something"
+    )
+  )
+
+  expect_error(res <- combineListRules(l1, l2))
+})