tests/testthat/test-conditional.R

context("conditional rules")

describe("is_condition_",{
  it("can detect a complex rule", {
    e <- quote(y == 1 | z <= 1)
    expect_true(is_condition_(e))
  })
  it("can use negated expression", {
    e <- quote(!y == 1 | z <= 1)
    expect_true(is_condition_(e))
  })
  it("can use nested expression", {
    e <- quote((y == 1) | z <= 1)
    expect_true(is_condition_(e))
  })
  it("can use negated nested expression", {
    e <- quote(!(y == 1 & x > 1) | z <= 1)
    expect_true(is_condition_(e))
  })
})

describe("conditional", {
  it("can detect conditional rules", {
    v <- validator( if ( x > 1) y == 1,
                    if (x > 1) a == "a1",
                    a %in% c("a1", "a2"), # pure categorical
                    if (A=="a") B == "b", # pure categorical
                    x > 1                 # pure linear
    )
    expect_equal( is_conditional(v)
                , c(TRUE, TRUE, FALSE, FALSE, FALSE))
  })
  it("can detect var_group conditional rules",{
    v <- validator( var_group(a,b) >= 0
                  , if (var_group(a,b) == "a") c == TRUE
                  , if (var_group(a,b) > 1) c == TRUE
                  )
   expect_equal(is_conditional(v), c(FALSE, FALSE, TRUE))
  })

  it("can detect more complex rules", {
    v <- validator( if ( x > 1 && z >= 1) y == 1,
                    if (x > 1) y == 1 || z <= 1,
                    if (x > 1) y == 1 | z <= 1,
                    y == 1 | z <= 1
    )
    expect_equal( is_conditional(v)
                  , c(TRUE, TRUE, TRUE, TRUE))
  })
})

describe("replace_linear", {
  it("can replace linear expressions",{
    e <- quote(if (x>1) A==TRUE)
    rl <- replace_linear(e)
    expect_equal(deparse(rl$cat), "if (.v1) A == TRUE")
    expect_equal(deparse(rl$linear$.v1), "x <= 1")
  })
  it("can replace linear expressions",{
    e <- quote(if (x>1) !(y > 1))
    rl <- replace_linear(e)
    expect_equal(deparse(rl$cat), "if (.v1) !(.v2)")
    expect_equal(deparse(rl$linear$.v1), "x <= 1")
    expect_equal(deparse(rl$linear$.v2), "y <= 1")
  })
  it ("transforms simple rule", {
    e <- quote(if(x > 1) y > 2)
    rl <- replace_linear(e)
    expect_equal(deparse(rl$cat), "if (.v1) !.v2")
    expect_equal(length(rl$linear), 2)
    expect_equal(deparse(rl$linear$.v1), "x <= 1")
    expect_equal(deparse(rl$linear$.v2), "y > 2")
  })
})

describe("cond_as_mip_rules",{
  it("transforms simple rule",{
    v <- validator(if(x>1) y>2)
    mr <- cond_as_mip_rules(v)
    expect_equal(length(mr), 3)
    expect_equal(mr[[1]]$rule, "V1")
    expect_equal(mr[[2]]$rule, "V1._lin1")
    expect_equal(mr[[3]]$rule, "V1._lin2")
    get_mr_matrix(mr)
  })

  it("transforms a categorical rule",{
    rules <- validator(A %in% c("a1", "a2"), if (A != "a1") x > 1)
    mr <- to_miprules(rules)
    expect_equal(mr[[2]]$a, c("A:a1" = -1, V2._lin1 = 1))
    expect_equal(mr[[2]]$b, 0)
    expect_equal(mr[[3]]$a, c(x = -1, V2._lin1 = -1e7))
    expect_equal(mr[[3]]$b, -1)
  })

  it("transforms a logical rule", {
    rules <- validator(if (a == FALSE) x > 1)
    mr <- to_miprules(rules)
    expect_equal(mr[[1]]$a, c(a = -1, V1._lin1 = 1))
    expect_equal(mr[[1]]$b, 0)
    expect_equal(mr[[2]]$a, c(x = -1, V1._lin1 = -1e7))
    expect_equal(mr[[2]]$b, -1)
  })
})
data-cleaning/errorlocate documentation built on Oct. 1, 2023, 1:04 p.m.