context("substitute_values")
library(validate)
test_that("substitute trival works", {
rules <- validator(rule1 = x > 1)
rules_sv <- substitute_values(rules, list(x=2), .add_constraints = FALSE)
expect_equal(rules_sv$rules, list())
rules_sv <- substitute_values(rules, list(x=2))
expect_equal(length(rules_sv), 1)
expect_equal(rules_sv$rules[[1]]@expr, quote(x == 2))
})
test_that("substitute multiple value works", {
rules <- validator(rule1 = x > 1, rule2 = y > x)
rules_sv <- substitute_values(rules, list(x=2, y=3), .add_constraints = FALSE)
expect_equal(rules_sv$rules, list())
})
test_that("substitute_value works", {
rules <- validator(rule1 = x > 1, rule2 = y > x)
rules_sv <- substitute_values(rules, list(x=2))
expect_equal(length(rules_sv$rules), 2)
rule2 <- rules_sv[[1]]
expect_equal(rule2@name, "rule2")
expect_equal(rule2@expr, quote(y > 2))
})
test_that("substitute wrong value gives warning", {
rules <- validator(rule1 = x > 1)
expect_warning(
substitute_values(rules, list(x=0))
)
})
test_that("substitute_value works with components", {
rules <- validator(gender %in% c("male","female"), if (gender == "male") x > 6)
rules_s <- substitute_values(rules, gender="female")
expect_equal(length(rules_s), 1)
expect_equal(rules_s$rules[[1]]@expr, quote(gender == 'female'))
rules_s <- substitute_values(rules, gender="male")
expect_equal(length(rules_s), 2)
#expect_equal(rules_s$exprs()[[1]], quote((x > 6)))
rules_s <- substitute_values(rules, .values = list(x=7))
# Nice! second rule always obeyed so removed...
expect_equal(length(rules_s), 2)
rules_s <- substitute_values(rules, .values = list(x=3))
# Nice! second rule can only obeyed when gender != male
expect_equal(length(rules_s), 3)
expect_equal(to_exprs(rules_s)[[2]], quote(gender != "male"))
})
test_that("substitute_value works with components %vin%", {
skip_if_not_installed("validate", minimum_version = "0.2.3")
rules <- validator(gender %vin% c("male","female"), if (gender == "male") x > 6)
rules_s <- substitute_values(rules, gender="female")
expect_equal(length(rules_s), 1)
expect_equal(rules_s$rules[[1]]@expr, quote(gender == 'female'))
rules_s <- substitute_values(rules, gender="male")
expect_equal(length(rules_s), 2)
#expect_equal(rules_s$exprs()[[1]], quote((x > 6)))
rules_s <- substitute_values(rules, .values = list(x=7))
# Nice! second rule always obeyed so removed...
expect_equal(length(rules_s), 2)
rules_s <- substitute_values(rules, .values = list(x=3))
# Nice! second rule can only obeyed when gender != male
expect_equal(length(rules_s), 3)
expect_equal(to_exprs(rules_s)[[2]], quote(gender != "male"))
})
test_that("reported issues are solved",{
rules <- validator(if (x>0) y==4)
rules_s <- substitute_values(rules, list(y=4))
expect_equal(length(rules_s), 1)
expect_equal(as.character(to_exprs(rules_s)), "y == 4")
a <- 1
rules <- validator( x > a)
rules_s <- substitute_values(rules, x = 0)
exprs_s <- to_exprs(rules_s)
expect_equal(exprs_s[[1]], quote( 0 > a))
})
test_that('Ton issue 11',{
rules <- validator(r1 = if (A == "1") B == TRUE)
rules_s <- substitute_values(rules, A = "1")
exprs_s <- to_exprs(rules_s)
expect_equal(exprs_s$r1, quote(B == TRUE))
expect_equal(exprs_s$.const_A, quote(A == "1"))
})
test_that('Sander issue 12',{
rules <- validator(
r1 = A %in% c('a','b'),
r2 = (A == "a") | (x >= -500) | (x <= 100))
rules_s <- substitute_values(rules, A = 'b', .add_constraints = FALSE)
exprs_s <- to_exprs(rules_s)
expect_equal(length(exprs_s), 1)
expect_equal(exprs_s$r2, quote(if (x < -500) x <= 100))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.