From 903c39ff9d3f9fbdf4e727ca7873b693d9f52e75 Mon Sep 17 00:00:00 2001 From: b_falquet Date: Thu, 17 Oct 2024 08:17:16 +0200 Subject: [PATCH 01/10] prototype to combine rules --- NAMESPACE | 2 + R/rules.R | 89 +++++++++++++++++++++++++++++++++++++++++++ _pkgdown.yaml | 1 + man/combine_rules.Rd | 34 +++++++++++++++++ man/modifyListRule.Rd | 39 +++++++++++++++++++ 5 files changed, 165 insertions(+) create mode 100644 man/combine_rules.Rd create mode 100644 man/modifyListRule.Rd diff --git a/NAMESPACE b/NAMESPACE index 1e357627..4e0c1694 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(assert_valid_list_format) export(attr_label) export(attr_label_df) export(co_relevels) +export(combine_rules) export(cut_by_group) export(get_arg) export(get_log) @@ -29,6 +30,7 @@ export(list2rules) export(log_filter) export(ls_explicit_na) export(ls_unite) +export(modifyListRule) export(multi_id_pivot_wider) export(poly_pivot_wider) export(print_log) diff --git a/R/rules.R b/R/rules.R index abf884d4..5260db6b 100644 --- a/R/rules.R +++ b/R/rules.R @@ -120,3 +120,92 @@ 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`. +#' +#' @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) { + assert_class(x, "rule", null.ok = TRUE) + assert_class(y, "rule", null.ok = TRUE) + + 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) + do.call(rule, r) +} + +#' Combine Rules Found in Lists of Rules. +#' +#' +#' @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" +#' ) +#' ) +#' +#' modifyListRule(l1, l2) +#' +#' +#' +modifyListRule <- function(x, val) { + checkmate::assert_list(x, null.ok = FALSE, names = "named") + checkmate::assert_list(val, null.ok = FALSE, names = "named") + + xnames <- names(x) + vnames <- names(val) + vnames <- vnames[nzchar(vnames)] + + for (v in vnames) { + x[[v]] <- if (v %in% xnames && is.list(x[[v]]) && is.list(val[[v]])) { + modifyListRule(x[[v]], val[[v]]) + } else { + combine_rules(x[[v]], val[[v]]) + } + } + x +} + + + + + diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 7aa00249..ea7467c8 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -47,6 +47,7 @@ reference: - rule - as.list.rule - list2rules + - combine_rules - title: Filtering contents: - log_filter diff --git a/man/combine_rules.Rd b/man/combine_rules.Rd new file mode 100644 index 00000000..4cd7aae2 --- /dev/null +++ b/man/combine_rules.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rules.R +\name{combine_rules} +\alias{combine_rules} +\title{Combine Two Rules} +\usage{ +combine_rules(x, y) +} +\arguments{ +\item{x}{(\code{rule}) to modify.} + +\item{y}{(\code{rule}) rule whose mapping will take precedence over the ones described in \code{x}.} +} +\value{ +a \code{rule}. +} +\description{ +Combine Two Rules +} +\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) +} diff --git a/man/modifyListRule.Rd b/man/modifyListRule.Rd new file mode 100644 index 00000000..ec676574 --- /dev/null +++ b/man/modifyListRule.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rules.R +\name{modifyListRule} +\alias{modifyListRule} +\title{Combine Rules Found in Lists of Rules.} +\usage{ +modifyListRule(x, val) +} +\description{ +Combine Rules Found in Lists of Rules. +} +\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" + ) +) + +modifyListRule(l1, l2) + + + +} From 86957d7ed0e8a94df98c5f630e2a2610d8ec612a Mon Sep 17 00:00:00 2001 From: b_falquet Date: Thu, 17 Oct 2024 10:55:58 +0200 Subject: [PATCH 02/10] add tests --- NAMESPACE | 2 +- NEWS.md | 1 + R/rules.R | 87 +++++++------- _pkgdown.yaml | 1 + ...{modifyListRule.Rd => combineListRules.Rd} | 19 +-- man/combine_rules.Rd | 26 ++-- tests/testthat/test-rules.R | 112 ++++++++++++++++++ 7 files changed, 191 insertions(+), 57 deletions(-) rename man/{modifyListRule.Rd => combineListRules.Rd} (67%) diff --git a/NAMESPACE b/NAMESPACE index 4e0c1694..05298a21 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ 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) @@ -30,7 +31,6 @@ export(list2rules) export(log_filter) export(ls_explicit_na) export(ls_unite) -export(modifyListRule) export(multi_id_pivot_wider) export(poly_pivot_wider) export(print_log) diff --git a/NEWS.md b/NEWS.md index 2b0728c8..3967ad25 100644 --- a/NEWS.md +++ b/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 diff --git a/R/rules.R b/R/rules.R index 5260db6b..9fdb5bed 100644 --- a/R/rules.R +++ b/R/rules.R @@ -122,43 +122,58 @@ as.list.rule <- function(x, ...) { } #' 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) { - assert_class(x, "rule", null.ok = TRUE) - assert_class(y, "rule", null.ok = TRUE) - +#' "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) - do.call(rule, r) + 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. #' +#' @returns a `list` of `rule` objects. #' @export #' @examples #' l1 <- list( @@ -170,7 +185,7 @@ combine_rules <- function(x, y) { #' ANYTHING = "anything" #' ) #' ) -#' +#' #' l2 <- list( #' r1 = rule( #' "first" = c("F", "f"), @@ -182,30 +197,22 @@ combine_rules <- function(x, y) { #' SOMETHING = "something" #' ) #' ) -#' -#' modifyListRule(l1, l2) -#' -#' #' -modifyListRule <- function(x, val) { - checkmate::assert_list(x, null.ok = FALSE, names = "named") - checkmate::assert_list(val, null.ok = FALSE, names = "named") - +#' combineListRules(l1, l2) +combineListRules <- function(x, val, ...) { + checkmate::assert_list(x, types = "rule", null.ok = FALSE, names = "named") + checkmate::assert_list(val, types = "rule", null.ok = FALSE, names = "named") + xnames <- names(x) vnames <- names(val) vnames <- vnames[nzchar(vnames)] - for (v in vnames) { - x[[v]] <- if (v %in% xnames && is.list(x[[v]]) && is.list(val[[v]])) { - modifyListRule(x[[v]], val[[v]]) - } else { - combine_rules(x[[v]], val[[v]]) - } + for (v in vnames) { + x[[v]] <- if (v %in% xnames && is.list(x[[v]]) && is.list(val[[v]])) { + modifyListRule(x[[v]], val[[v]], ...) + } else { + combine_rules(x[[v]], val[[v]], ...) } + } x } - - - - - diff --git a/_pkgdown.yaml b/_pkgdown.yaml index ea7467c8..1ee90d08 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -48,6 +48,7 @@ reference: - as.list.rule - list2rules - combine_rules + - combineListRules - title: Filtering contents: - log_filter diff --git a/man/modifyListRule.Rd b/man/combineListRules.Rd similarity index 67% rename from man/modifyListRule.Rd rename to man/combineListRules.Rd index ec676574..227db013 100644 --- a/man/modifyListRule.Rd +++ b/man/combineListRules.Rd @@ -1,10 +1,18 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/rules.R -\name{modifyListRule} -\alias{modifyListRule} +\name{combineListRules} +\alias{combineListRules} \title{Combine Rules Found in Lists of Rules.} \usage{ -modifyListRule(x, val) +combineListRules(x, val, ...) +} +\arguments{ +\item{x}{(\code{list}) of \code{rule} objects.} + +\item{val}{(\code{list}) of \code{rule} objects.} +} +\value{ +a \code{list} of \code{rule} objects. } \description{ Combine Rules Found in Lists of Rules. @@ -32,8 +40,5 @@ l2 <- list( ) ) -modifyListRule(l1, l2) - - - +combineListRules(l1, l2) } diff --git a/man/combine_rules.Rd b/man/combine_rules.Rd index 4cd7aae2..af8ba673 100644 --- a/man/combine_rules.Rd +++ b/man/combine_rules.Rd @@ -4,12 +4,16 @@ \alias{combine_rules} \title{Combine Two Rules} \usage{ -combine_rules(x, y) +combine_rules(x, y, safe = TRUE, ...) } \arguments{ \item{x}{(\code{rule}) to modify.} \item{y}{(\code{rule}) rule whose mapping will take precedence over the ones described in \code{x}.} + +\item{safe}{(\code{flag}) whether to throw an error if both rules are \code{NULL}. Otherwise return the empty rule: \code{rule()}.} + +\item{...}{not used.} } \value{ a \code{rule}. @@ -17,18 +21,22 @@ a \code{rule}. \description{ Combine Two Rules } +\note{ +The order of the mappings in the resulting rule corresponds to the order of the mappings in \code{y} followed by the +mappings in \code{x}. +} \examples{ r1 <- rule( - "first" = c("from ori rule", "FROM ORI RULE"), - "last" = c(NA, "last"), - .to_NA = "X", - .drop = TRUE + "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" + "first" = c("F", "f"), + "second" = c("S", "s"), + "third" = c("T", "t"), + .to_NA = "something" ) combine_rules(r1, r2) } diff --git a/tests/testthat/test-rules.R b/tests/testthat/test-rules.R index 10653848..3ea41df9 100644 --- a/tests/testthat/test-rules.R +++ b/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) + 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)) +}) From 50e9b49911438cbfe15c3f87bcc5d7dc96d7fb80 Mon Sep 17 00:00:00 2001 From: b_falquet Date: Thu, 17 Oct 2024 11:06:02 +0200 Subject: [PATCH 03/10] add missing namespace --- tests/testthat/test-rules.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-rules.R b/tests/testthat/test-rules.R index 3ea41df9..a57d2104 100644 --- a/tests/testthat/test-rules.R +++ b/tests/testthat/test-rules.R @@ -182,7 +182,7 @@ test_that("combineListRules works as expected", { ) res <- combineListRules(l1, l2) - expect_list(res, types = "rule", len = 3, names = "named") + checkmate::expect_list(res, types = "rule", len = 3, names = "named") expect_identical(names(res), c("r1", "r2", "r3")) expect_identical( From 88d3184a33268dd845f182dd46c5f75039d90e12 Mon Sep 17 00:00:00 2001 From: b_falquet Date: Thu, 17 Oct 2024 11:50:38 +0200 Subject: [PATCH 04/10] simplify function --- R/rules.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/rules.R b/R/rules.R index 9fdb5bed..5e189a02 100644 --- a/R/rules.R +++ b/R/rules.R @@ -208,11 +208,7 @@ combineListRules <- function(x, val, ...) { vnames <- vnames[nzchar(vnames)] for (v in vnames) { - x[[v]] <- if (v %in% xnames && is.list(x[[v]]) && is.list(val[[v]])) { - modifyListRule(x[[v]], val[[v]], ...) - } else { - combine_rules(x[[v]], val[[v]], ...) - } + x[[v]] <- combine_rules(x[[v]], val[[v]], ...) } x } From e55b1f11802d3067a98287df52d2f86dde7b1dda Mon Sep 17 00:00:00 2001 From: b_falquet Date: Thu, 17 Oct 2024 11:52:18 +0200 Subject: [PATCH 05/10] document --- R/rules.R | 1 + man/combineListRules.Rd | 2 ++ 2 files changed, 3 insertions(+) diff --git a/R/rules.R b/R/rules.R index 5e189a02..196e56ea 100644 --- a/R/rules.R +++ b/R/rules.R @@ -172,6 +172,7 @@ combine_rules <- function(x, y, safe = TRUE, ...) { #' #' @param x (`list`) of `rule` objects. #' @param val (`list`) of `rule` objects. +#' @param ... passed to `combine_rules`. #' #' @returns a `list` of `rule` objects. #' @export diff --git a/man/combineListRules.Rd b/man/combineListRules.Rd index 227db013..21f0a559 100644 --- a/man/combineListRules.Rd +++ b/man/combineListRules.Rd @@ -10,6 +10,8 @@ combineListRules(x, val, ...) \item{x}{(\code{list}) of \code{rule} objects.} \item{val}{(\code{list}) of \code{rule} objects.} + +\item{...}{passed to \code{combine_rules}.} } \value{ a \code{list} of \code{rule} objects. From a76e7b008e7d34f1410a4724eed0ae49511799b4 Mon Sep 17 00:00:00 2001 From: b_falquet Date: Thu, 17 Oct 2024 14:13:46 +0200 Subject: [PATCH 06/10] ensure unique names in list --- R/rules.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/rules.R b/R/rules.R index 196e56ea..23d9291c 100644 --- a/R/rules.R +++ b/R/rules.R @@ -201,8 +201,8 @@ combine_rules <- function(x, y, safe = TRUE, ...) { #' #' combineListRules(l1, l2) combineListRules <- function(x, val, ...) { - checkmate::assert_list(x, types = "rule", null.ok = FALSE, names = "named") - checkmate::assert_list(val, types = "rule", null.ok = FALSE, names = "named") + 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) From 2bd251753c2548c38cbe76aab38566a3dc195e9c Mon Sep 17 00:00:00 2001 From: b_falquet Date: Fri, 18 Oct 2024 08:31:15 +0200 Subject: [PATCH 07/10] liming's suggestions --- NAMESPACE | 2 +- NEWS.md | 2 +- R/rules.R | 4 ++-- _pkgdown.yaml | 2 +- man/{combineListRules.Rd => combine_list_rules.Rd} | 8 ++++---- tests/testthat/test-rules.R | 10 +++++----- 6 files changed, 14 insertions(+), 14 deletions(-) rename man/{combineListRules.Rd => combine_list_rules.Rd} (87%) diff --git a/NAMESPACE b/NAMESPACE index 05298a21..68121ead 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,7 +21,7 @@ export(assert_valid_list_format) export(attr_label) export(attr_label_df) export(co_relevels) -export(combineListRules) +export(combine_list_rules) export(combine_rules) export(cut_by_group) export(get_arg) diff --git a/NEWS.md b/NEWS.md index 3967ad25..7141f0b3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +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. +* New `combine_rules` and `combine_list_rules` functions to combine rules or list of rules into a single rule or a single list of rules. # dunlin 0.1.6 diff --git a/R/rules.R b/R/rules.R index 23d9291c..822cd819 100644 --- a/R/rules.R +++ b/R/rules.R @@ -199,8 +199,8 @@ combine_rules <- function(x, y, safe = TRUE, ...) { #' ) #' ) #' -#' combineListRules(l1, l2) -combineListRules <- function(x, val, ...) { +#' combine_list_rules(l1, l2) +combine_list_rules <- 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") diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 1ee90d08..c537db15 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -48,7 +48,7 @@ reference: - as.list.rule - list2rules - combine_rules - - combineListRules + - combine_list_rules - title: Filtering contents: - log_filter diff --git a/man/combineListRules.Rd b/man/combine_list_rules.Rd similarity index 87% rename from man/combineListRules.Rd rename to man/combine_list_rules.Rd index 21f0a559..be94acc0 100644 --- a/man/combineListRules.Rd +++ b/man/combine_list_rules.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/rules.R -\name{combineListRules} -\alias{combineListRules} +\name{combine_list_rules} +\alias{combine_list_rules} \title{Combine Rules Found in Lists of Rules.} \usage{ -combineListRules(x, val, ...) +combine_list_rules(x, val, ...) } \arguments{ \item{x}{(\code{list}) of \code{rule} objects.} @@ -42,5 +42,5 @@ l2 <- list( ) ) -combineListRules(l1, l2) +combine_list_rules(l1, l2) } diff --git a/tests/testthat/test-rules.R b/tests/testthat/test-rules.R index a57d2104..f66707bc 100644 --- a/tests/testthat/test-rules.R +++ b/tests/testthat/test-rules.R @@ -156,9 +156,9 @@ test_that("combine_rules works as expected when both rules are `NULL` values", { expect_identical(res, rule()) }) -# combineListRules ---- +# combine_list_rules ---- -test_that("combineListRules works as expected", { +test_that("combine_list_rules works as expected", { l1 <- list( r1 = rule( "first" = c("will be overwritten", "WILL BE OVERWRITTEN"), @@ -181,7 +181,7 @@ test_that("combineListRules works as expected", { ) ) - res <- combineListRules(l1, l2) + res <- combine_list_rules(l1, l2) checkmate::expect_list(res, types = "rule", len = 3, names = "named") expect_identical(names(res), c("r1", "r2", "r3")) @@ -212,7 +212,7 @@ test_that("combineListRules works as expected", { }) -test_that("combineListRules fails as expected when elements are not rules", { +test_that("combine_list_rules fails as expected when elements are not rules", { l1 <- list( r1 = NULL ) @@ -226,5 +226,5 @@ test_that("combineListRules fails as expected when elements are not rules", { ) ) - expect_error(res <- combineListRules(l1, l2)) + expect_error(res <- combine_list_rules(l1, l2)) }) From c801e6c2e2004ad7876c4b55416192d39330e5c2 Mon Sep 17 00:00:00 2001 From: b_falquet Date: Wed, 23 Oct 2024 11:46:29 +0200 Subject: [PATCH 08/10] upate rule order --- R/rules.R | 24 +++++++++++++++--------- man/combine_list_rules.Rd | 2 +- man/combine_rules.Rd | 8 +++----- tests/testthat/test-rules.R | 12 ++++-------- 4 files changed, 23 insertions(+), 23 deletions(-) diff --git a/R/rules.R b/R/rules.R index 781aed77..d49dc79f 100644 --- a/R/rules.R +++ b/R/rules.R @@ -130,11 +130,10 @@ as.list.rule <- function(x, ...) { #' #' @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`. +#' @note The order of the mappings in the resulting rule corresponds to the order of the mappings in `x` followed by the +#' mappings that are only present in `y`. #' #' @returns a `rule`. #' @export @@ -152,12 +151,11 @@ as.list.rule <- function(x, ...) { #' .to_NA = "something" #' ) #' combine_rules(r1, r2) -combine_rules <- function(x, y, safe = TRUE, ...) { +combine_rules <- function(x, y, ...) { 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) { + if (is.null(x) && is.null(y)) { rlang::abort("Both rules are NULL.") } @@ -165,10 +163,18 @@ combine_rules <- function(x, y, safe = TRUE, ...) { x <- as.list(x) y <- as.list(y) names_y <- names(y) - names_x <- setdiff(names(x), names(y)) + names_x <- names(x) + names_x_diff <- setdiff(names_x, names_y) + - x <- x[names_x] + x <- x[names_x_diff] r <- c(y, x) + + # reorder to follow original order + names_y_diff <- setdiff(names_y, names_x) + names_order <- c(names_x, names_y_diff) + r <- r[names_order] + r <- do.call(rule, r) r } @@ -177,7 +183,7 @@ combine_rules <- function(x, y, safe = TRUE, ...) { #' #' @param x (`list`) of `rule` objects. #' @param val (`list`) of `rule` objects. -#' @param ... passed to `combine_rules`. +#' @param ... passed to [`dunlin::combine_rules`]. #' #' @returns a `list` of `rule` objects. #' @export diff --git a/man/combine_list_rules.Rd b/man/combine_list_rules.Rd index be94acc0..8b6cd3a7 100644 --- a/man/combine_list_rules.Rd +++ b/man/combine_list_rules.Rd @@ -11,7 +11,7 @@ combine_list_rules(x, val, ...) \item{val}{(\code{list}) of \code{rule} objects.} -\item{...}{passed to \code{combine_rules}.} +\item{...}{passed to \code{\link{combine_rules}}.} } \value{ a \code{list} of \code{rule} objects. diff --git a/man/combine_rules.Rd b/man/combine_rules.Rd index af8ba673..a6d6e5a0 100644 --- a/man/combine_rules.Rd +++ b/man/combine_rules.Rd @@ -4,15 +4,13 @@ \alias{combine_rules} \title{Combine Two Rules} \usage{ -combine_rules(x, y, safe = TRUE, ...) +combine_rules(x, y, ...) } \arguments{ \item{x}{(\code{rule}) to modify.} \item{y}{(\code{rule}) rule whose mapping will take precedence over the ones described in \code{x}.} -\item{safe}{(\code{flag}) whether to throw an error if both rules are \code{NULL}. Otherwise return the empty rule: \code{rule()}.} - \item{...}{not used.} } \value{ @@ -22,8 +20,8 @@ a \code{rule}. Combine Two Rules } \note{ -The order of the mappings in the resulting rule corresponds to the order of the mappings in \code{y} followed by the -mappings in \code{x}. +The order of the mappings in the resulting rule corresponds to the order of the mappings in \code{x} followed by the +mappings that are only present in \code{y}. } \examples{ r1 <- rule( diff --git a/tests/testthat/test-rules.R b/tests/testthat/test-rules.R index bc81ff55..b7c46641 100644 --- a/tests/testthat/test-rules.R +++ b/tests/testthat/test-rules.R @@ -131,7 +131,7 @@ test_that("combine_rules works as expected", { 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)) + expect_identical(res, rule(a = "3", b = "2", c = "4", .to_NA = "y", .drop = FALSE, .na_last = TRUE)) }) test_that("combine_rules works as expected with `NULL` values", { @@ -152,14 +152,10 @@ test_that("combine_rules works as expected with `NULL` values", { expect_identical(res, r1) }) -test_that("combine_rules works as expected when both rules are `NULL` values", { +test_that("combine_rules fails 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()) }) # combine_list_rules ---- @@ -168,7 +164,7 @@ test_that("combine_list_rules works as expected", { l1 <- list( r1 = rule( "first" = c("will be overwritten", "WILL BE OVERWRITTEN"), - "last" = c(NA, "last") + "almost first" = c(NA, "ALMOST FIRST") ), r2 = rule( ANYTHING = "anything" @@ -195,9 +191,9 @@ test_that("combine_list_rules works as expected", { res$r1, rule( "first" = c("F", "f"), + "almost first" = c(NA, "ALMOST FIRST"), "second" = c("S", "s"), "third" = c("T", "t"), - "last" = c(NA, "last"), .to_NA = "something" ) ) From 61ca4730fb988d14003b2044169a2bfaac5b66d1 Mon Sep 17 00:00:00 2001 From: b_falquet Date: Wed, 23 Oct 2024 11:53:21 +0200 Subject: [PATCH 09/10] linter --- R/rules.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/rules.R b/R/rules.R index d49dc79f..d03af402 100644 --- a/R/rules.R +++ b/R/rules.R @@ -165,16 +165,15 @@ combine_rules <- function(x, y, ...) { names_y <- names(y) names_x <- names(x) names_x_diff <- setdiff(names_x, names_y) - x <- x[names_x_diff] r <- c(y, x) - - # reorder to follow original order + + # Reorder to follow original order names_y_diff <- setdiff(names_y, names_x) names_order <- c(names_x, names_y_diff) r <- r[names_order] - + r <- do.call(rule, r) r } From 3d8fbb9ea9be14574e80ca2d9410a3f3388dff86 Mon Sep 17 00:00:00 2001 From: b_falquet Date: Thu, 24 Oct 2024 09:29:53 +0200 Subject: [PATCH 10/10] liming's suggestions --- R/rules.R | 20 +++++--------------- man/combine_list_rules.Rd | 4 ++-- 2 files changed, 7 insertions(+), 17 deletions(-) diff --git a/R/rules.R b/R/rules.R index d03af402..61428d92 100644 --- a/R/rules.R +++ b/R/rules.R @@ -162,19 +162,10 @@ combine_rules <- function(x, y, ...) { # 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 <- names(x) - names_x_diff <- setdiff(names_x, names_y) - x <- x[names_x_diff] - r <- c(y, x) + x[names(y)] <- y - # Reorder to follow original order - names_y_diff <- setdiff(names_y, names_x) - names_order <- c(names_x, names_y_diff) - r <- r[names_order] - - r <- do.call(rule, r) + r <- do.call(rule, x) r } @@ -189,8 +180,8 @@ combine_rules <- function(x, y, ...) { #' @examples #' l1 <- list( #' r1 = rule( -#' "first" = c("from ori rule", "FROM ORI RULE"), -#' "last" = c(NA, "last") +#' "first" = c("overwritten", "OVERWRITTEN"), +#' "almost first" = c(NA, "almost") #' ), #' r2 = rule( #' ANYTHING = "anything" @@ -211,12 +202,11 @@ combine_rules <- function(x, y, ...) { #' #' combine_list_rules(l1, l2) combine_list_rules <- function(x, val, ...) { + # Unique names prevents zero-character names. 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]], ...) diff --git a/man/combine_list_rules.Rd b/man/combine_list_rules.Rd index 8b6cd3a7..afe247e0 100644 --- a/man/combine_list_rules.Rd +++ b/man/combine_list_rules.Rd @@ -22,8 +22,8 @@ Combine Rules Found in Lists of Rules. \examples{ l1 <- list( r1 = rule( - "first" = c("from ori rule", "FROM ORI RULE"), - "last" = c(NA, "last") + "first" = c("overwritten", "OVERWRITTEN"), + "almost first" = c(NA, "almost") ), r2 = rule( ANYTHING = "anything"