Nothing
context("HC ODE")
test_that("augmenting ODE arcs nominal", {
a <- arcs_to_orphans(letters[1:4], letters[6:10])
expect_equal(nrow(a), 6 * 2 + 20)
expect_equal(a, unique(a))
})
test_that("augmenting ODE arcs no orphans", {
a <- arcs_to_orphans(NULL, letters[6:10])
expect_null(a)
})
test_that("augmenting ODE arcs overlapping", {
expect_error(arcs_to_orphans(letters[1:6], letters[6:10]), 'disjoint')
})
test_that("augmenting ODE arcs no non-orphans", {
a <- arcs_to_orphans(letters[1:6], NULL)
expect_equal(nrow(a), 15 * 2)
expect_equal(a, unique(a))
})
test_that("Remove cycles single cycle", {
nb <- nbcarp(car[, 5:7])
nb <- add_feature_parents('lug_boot', 'safety', nb)
a <- arcs_to_orphans('lug_boot', 'safety')
d <- discard_cycles(a, nb)
expect_equal(nrow(d), 0)
})
test_that("Remove cycles two cycles", {
nb <- nbcarp(car[, 4:7])
nb <- add_feature_parents('lug_boot', 'safety', nb)
nb <- add_feature_parents('lug_boot', 'persons', nb)
a <- arcs_to_orphans('lug_boot', c('safety', 'persons'))
d <- discard_cycles(a, nb)
expect_equal(nrow(d), 0)
})
test_that("Remove cycles: cycles and non-cycle", {
nb <- nbcarp(car[, 4:7])
nb <- add_feature_parents('lug_boot', 'safety', nb)
a <- arcs_to_orphans(c('lug_boot', 'persons'), 'safety')
d <- discard_cycles(a, nb)
a <- as.matrix(a)
expect_equivalent(d, a[-1, ])
expect_equivalent(d[1, ], c('safety', 'persons'))
})
test_that("Discard perms two-column mat", {
m <- matrix(c('a', 'b', 'b', 'a'), ncol = 2)
n <- discard_reversed(m)
expect_equal(n, m[2, , drop = FALSE])
})
test_that("Discard perms empty mat", {
m <- matrix(character(), ncol = 2)
n <- discard_reversed(m)
expect_equal(ncol(n), 2)
expect_equal(nrow(n), 0)
})
test_that("augment arcs nominal", {
nb <- nbcar()
a <- augment_ode_arcs(nb)
expect_equal(nrow(a), 15)
})
test_that("augment arcs no features", {
nb <- nbcarclass()
expect_error(augment_ode_arcs(nb), "orphans")
})
test_that("augment arcs no arcs", {
nb <- nbcarp(car[, 6:7])
a <- augment_ode_arcs(nb)
expect_equal(nrow(a), 0)
})
test_that("augment arcs one arc nominal", {
nb <- nbcarp(car[, 5:7])
a <- augment_ode_arcs(nb)
expect_equal(nrow(a), 1)
expect_equal(a[1, ], c(from = 'safety', to = 'lug_boot'))
})
test_that("augment arcs one arc nominal", {
nb <- nbcarp(car[, -(3:5)])
a <- augment_ode_arcs(nb)
expect_equal(nrow(a), 3)
})
test_that("augment arcs", {
nb <- nbcarp(car[, 4:7])
nb <- add_feature_parents('lug_boot', 'safety', nb)
a <- augment_ode_arcs(nb)
expect_equal(nrow(a), 2)
expect_equal(a[1, ], c(from = 'safety', to = 'persons'))
expect_equal(a[2, ], c(from = 'lug_boot', to = 'persons'))
})
test_that("augment ode nominal", {
nb <- nbcar()
anbs <- augment_ode(nb)
expect_equal(length(anbs), 15)
})
test_that("augment ode iterate", {
nb <- nbcarp(car[ , 4:7])
anbs <- augment_ode(nb)
expect_equal(length(anbs), 3)
nb <- anbs[[1]]
anbs <- augment_ode(nb)
expect_equal(length(anbs), 2)
nb <- anbs[[1]]
anbs <- augment_ode(nb)
expect_equal(length(anbs), 0)
})
test_that("Superparents nominal", {
nb <- nbcar()
a <- superparent_children(nb)
expect_equal(length(a), 6)
expect_equal(a[[1]], setdiff(features(nb), 'buying'))
expect_equal(a[[6]], setdiff(features(nb), 'safety'))
})
test_that("Superparents one feature", {
nb <- nbcarp(car[, 6:7])
a <- superparent_children(nb)
expect_null(a)
})
test_that("Superparents no orphans", {
nb <- nbcarp(car[, 5:7])
nb <- add_feature_parents('safety', 'lug_boot', nb)
a <- superparent_children(nb)
expect_null(a)
})
test_that("augment ode hc nominal", {
nb <- nbcar()
mem <- make_cpts_cache(car, smooth = 0.01)
a <- augment_ode_sp(nb, NULL, train = list(mem, mem), test = list(car, car))
expect_equal(length(a), 5)
})
test_that("Discard existing", {
nb <- nbcarp(car)
arcs <- arcs_to_orphans(features(nb), character())
d <- discard_existing(arcs, nb)
expect_equal(nrow(d), nrow(arcs))
nb <- add_feature_parents('lug_boot', 'safety', nb)
d <- discard_existing(arcs, nb)
expect_equal(nrow(d), nrow(arcs) - 1)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.