context("Learn params")
test_that("learn params", {
# Check call and environment
n <- nb('class', car)
nf <- lp(n, car, smooth = 1)
nf2 <- bnc_update(bnc_get_update_args(nf, dag = FALSE), car)
expect_identical(nf, nf2)
})
test_that("Uniform probability instead of 0", {
cbs <- car[1:4, c('buying', 'safety')]
nb <- lp(nb('buying', cbs), cbs, smooth = 0)
p <- as.vector(params(nb)[['safety']][, 'low'])
expect_equal(p, rep(0.33333333, 3))
})
test_that("Smoothing", {
cbs <- car[1:4, c('buying', 'safety')]
nb <- lp(nb('safety', cbs), cbs, smooth = 0)
expect_equivalent(params(nb)[['safety']]['low'], 0.5)
nb <- lp(nb('safety', car[, c('buying', 'safety')]), car[1:4, ], smooth = 1)
expect_equivalent(params(nb)[['safety']]['low'], 3/7)
})
test_that('Set feature weights', {
nb <- nbcar()
w <- structure(rep(0.5, 6), names = features(nb))
f <- set_weights(nb, w)
expect_equal(params(f)$class, params(nb)$class)
expect_true(all(params(f)$buying != params(nb)$buying))
expect_true(are_pdists(t(params(f)$buying)))
})
test_that('awnb nominal', {
nb <- nbcar()
a <- lp(nb, car, smooth = 1, awnb_trees = 1, awnb_bootstrap = 1)
b <- lp(nb, car, smooth = 1)
expect_equal(params(a)$class, params(b)$class)
expect_true(all(params(a)$buying != params(b)$buying))
expect_true(are_pdists(t(params(a)$buying)))
expect_equal(a$.call_bn[[1]], "lp")
})
test_that("awnb do not call", {
nb <- nbcar()
a <- lp(nb, car, smooth = 1, awnb_trees = NULL, awnb_bootstrap = NULL)
b <- lp(nb, car, smooth = 1)
identical_non_call(a, b)
})
test_that('awnb default params', {
nb <- nbcar()
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
a <- lp(nb, car, smooth = 1, awnb_trees = 10, awnb_bootstrap = 0.5)
set.seed(0)
b <- lp(nb, car, smooth = 1, awnb_trees = 10)
identical_non_call(a, b)
set.seed(0)
b <- lp(nb, car, smooth = 1, awnb_bootstrap = 0.5)
identical_non_call(a, b)
})
test_that("awnb Incomplete data" , {
a <- nb('Class', voting)
b <- lp(a, voting, smooth = 1, awnb_trees = 1, awnb_bootstrap = 0.1)
c <- lp(a, voting, smooth = 1)
expect_equal(params(b), params(set_weights(c, awnb_weights(b))))
})
test_that('bnc function nominal', {
a <- bnc('nb', 'class', car, smooth = 1)
b <- lp(nb('class', car), car, smooth = 1, awnb_trees = NULL,
awnb_bootstrap = NULL, manb_prior = NULL, wanbia = NULL)
expect_identical(a, b)
})
test_that('bnc with args', {
a <- bnc('tan_cl', 'class', car, smooth = 1, dag_args = list(root = 'safety'))
b <- lp(tan_cl('class', car, root = 'safety'), car, smooth = 1,
awnb_trees = NULL, awnb_bootstrap = NULL, manb_prior = NULL, wanbia = NULL)
expect_identical(a, b)
})
test_that('bnc with args and awnb', {
set.seed(0)
a <- bnc('tan_cl', 'class', car, smooth = 1, dag_args = list(root = 'safety'),
awnb_trees = 10)
set.seed(0)
b <- lp(tan_cl('class', car, root = 'safety'), car, smooth = 1,
awnb_trees = 10, awnb_bootstrap = NULL, manb_prior = NULL, wanbia = NULL)
expect_identical(a, b)
})
test_that('lp_implement with cache nominal', {
n <- nb('class', car)
a <- make_cpts_cache(car, smooth = 0.04)
e <- lp_implement(n, .mem_cpts = a)
b <- lp_implement(n, car, smooth = 0.04)
expect_identical(e, b)
})
test_that('either awnb or manb', {
n <- nb('class', car)
expect_error(lp(n, car, smooth = 1, awnb_trees = 2, manb_prior = 0.3),
"Either MANB, AWNB, WANBIA can be applied, not more than one.")
expect_error(lp(n, car, smooth = 1, awnb_bootstrap = 1, manb_prior = 0.3),
"Either MANB, AWNB, WANBIA can be applied, not more than one.")
})
test_that("manb nominal", {
nb <- nbcar()
manb <- lp(nb, car, smooth = 1, manb_prior = 0.5)
expect_equivalent(manb$.manb, c(1, 1, 0.000026294701543, 1, 1, 1))
expect_equal(names(manb$.params), names(nb$.params))
expect_equal(sum(abs(manb$.params[['doors']] - nb$.params[['doors']])),
0.3950593, tolerance = 1e-7)
nb <- nbcar()
manb <- lp(nb, car, smooth = 1)
expect_null(manb$.manb)
expect_identical(manb$.params, nb$.params)
})
test_that("check manb predictions match wei java implementation", {
nb <- lp(nb('class', car), car, smooth = 1)
manb <- lp(nb, car, smooth = 1, manb_prior = 0.5)
p <- predict(manb, car, prob = TRUE)
expect_equal(as.vector(p[12, 2]), 0.301507, tolerance = 0.0000002)
expect_equal(as.vector(p[1646, 2]), 0.307484, tolerance = 0.000002)
expect_equal(as.vector(p[1728, 2]), 0.209418, tolerance = 0.000002)
nb <- lp(nb('class', car), car, smooth = 1)
manb <- lp(nb, car, smooth = 1, manb_prior = 0.00001)
p <- predict(manb, car, prob = TRUE)
expect_equal(as.vector(p[12, 2]), 0.301510, tolerance = 0.000002)
expect_equal(as.vector(p[18, 2]), 0.418681, tolerance = 0.000002)
})
test_that("wanbia", {
n <- nb('Class', v)
w <- lp(n, v, smooth = 1, wanbia = TRUE)
nb <- lp(n, v, smooth = 1)
expect_lt(sum(abs(params(w)$anti_satellite_test_ban - 0.5)), 1e-10)
expect_lt(compute_cll(nb, v), compute_cll(w, v))
# For car no weights seem to improve
n <- nb('class', car)
nb <- lp(n, car, smooth = 1)
w <- lp(n, car, smooth = 1, wanbia = TRUE)
expect_equal(compute_cll(nb, car), compute_cll(w, car))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.