diff --git a/NAMESPACE b/NAMESPACE index 8cd5df3c..6291babe 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(h_as_factor) export(h_ws_to_explicit_na) export(h_ws_to_na) export(join_adsub_adsl) +export(list2rules) export(mini_pivot_wider) export(multi_pivot_wider) export(poly_pivot_wider) diff --git a/R/rules.R b/R/rules.R index 4e2939bb..7ffe41df 100644 --- a/R/rules.R +++ b/R/rules.R @@ -37,6 +37,24 @@ print.rule <- function(x, ...) { } } +#' Read yaml File describing `rule` +#' @param obj (`nested list`) to convert into list of rules. +#' @export +#' @examples +#' obj <- list( +#' rule1 = list("X" = c("a", "b"), "Z" = "c"), +#' rule2 = list(Missing = c(NA, "")) +#' ) +#' list2rules(obj) +#' +list2rules <- function(obj) { + coll <- checkmate::makeAssertCollection() + checkmate::assert_list(obj, unique = TRUE, types = "list", add = coll) + checkmate::assert_names(names(obj), type = "unique", add = coll) + checkmate::reportAssertions(coll) + + lapply(obj, function(x) rule(.lst = x)) +} #' Convert Rule to List #' @param x (`rule`) to convert. @@ -67,5 +85,5 @@ print.empty_rule <- function(x, ...) { read_rules <- function(file) { checkmate::assert_file_exists(file) content <- yaml::read_yaml(file) - lapply(content, function(x) rule(.lst = x)) + list2rules(content) } diff --git a/_pkgdown.yaml b/_pkgdown.yaml index 1932d0d8..edce05a5 100644 --- a/_pkgdown.yaml +++ b/_pkgdown.yaml @@ -37,6 +37,7 @@ reference: - rule - as.list.rule - empty_rule + - list2rules - read_rules - title: Assertions contents: diff --git a/man/list2rules.Rd b/man/list2rules.Rd new file mode 100644 index 00000000..9bd1cf67 --- /dev/null +++ b/man/list2rules.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rules.R +\name{list2rules} +\alias{list2rules} +\title{Read yaml File describing \code{rule}} +\usage{ +list2rules(obj) +} +\arguments{ +\item{obj}{(\verb{nested list}) to convert into list of rules.} +} +\description{ +Read yaml File describing \code{rule} +} +\examples{ +obj <- list( + rule1 = list("X" = c("a", "b"), "Z" = "c"), + rule2 = list(Missing = c(NA, "")) +) +list2rules(obj) + +} diff --git a/tests/testthat/test-rules.R b/tests/testthat/test-rules.R index cb2e8ab7..e6348766 100644 --- a/tests/testthat/test-rules.R +++ b/tests/testthat/test-rules.R @@ -55,6 +55,43 @@ test_that("emtpy_rule printed correctly", { expect_snapshot(empty_rule) }) +# list2rules ---- + +test_that("list2rules works as expected", { + r1 <- list( + rule_a = list(a = 1, b = 2), + rule_b = list(a = 3, b = 4), + rule_c = list() + ) + + expect_silent(res <- list2rules(r1)) + + checkmate::expect_list(res, type = "rule", len = 3) + expect_identical(names(res), c("rule_a", "rule_b", "rule_c")) +}) + +test_that("list2rules fails as expected", { + r1 <- list( + rule_a = list(a = 1, b = 2), + rule_b = list(a = 3, b = 4), + rule_a_again = list(a = 1, b = 2), + rule_b = list("X" = "x") + ) + + res <- expect_error(capture_output_lines(list2rules(r1), width = 200, print = FALSE)) + + expect_match( + res$message, + "* Variable 'obj': Contains duplicated values, position 3.", + fixed = TRUE + ) + expect_match( + res$message, + "* Variable 'names(obj)': Must have unique names, but element 4 is duplicated.", + fixed = TRUE + ) +}) + # rule reading ---- test_that("list of rules are read correctly", {