Nothing
context("cv")
test_that("CV a structure with no fitting args", {
n <- nb('class', car)
expect_error(cv(n, car, k = 5, dag = FALSE), "elements")
})
test_that("CV a bnc_bn", {
n <- lp(nb('class', car), car, 1)
a <- cv(n, car, k = 5, dag = FALSE)
expect_true( a > 0.5)
})
test_that("CV two bnc_bns for fitting", {
n <- lp(nb('class', car), car, 1)
m <- lp(nb('class', car[, c(1, 3, 7)]), car, 1)
a <- cv(list(n, m), car, k = 5, dag = FALSE)
expect_equal(length(a), 2L)
expect_true(all(a > 0.5))
})
test_that("CV means = FALSE", {
n <- lp(nb('class', car), car, 1)
m <- lp(nb('class', car[, c(1, 3, 7)]), car, 1)
a <- cv(list(n, m), car, k = 5, dag = FALSE, mean = FALSE)
expect_equal(ncol(a), 2L)
expect_equal(nrow(a), 5L)
expect_true(all(colMeans(a) > 0.5))
})
test_that("CV two bnc_bns to repeat learning", {
n <- lp(nb('class', car), car, 1)
m <- lp(nb('class', car[, c(1, 3, 7)]), car, 1)
# Fitting does not fail on just 2 columns, as dag is re-learned on
# those columns
a <- cv(list(n, m), car[ , c(1, 7)], k = 5, dag = TRUE)
expect_equal(length(a), 2L)
expect_true(all(a > 0.5))
# With dag = FALSE it fails
expect_error(cv(list(n, m), car[ , c(1, 7)], k = 5, dag = FALSE), "not found")
})
test_that("CV classifier names", {
n <- lp(nb('class', car), car, 1)
m <- lp(nb('class', car[, c(1, 3, 7)]), car, 1)
a <- cv(list(a = n, b = m), car[ , c(1, 7)], k = 5, dag = TRUE)
expect_equal(names(a), letters[1:2])
})
test_that("Fast structure fitting with smooth", {
a <- lp(nb('class', car), car, smooth = 1)
b <- lp(nb('class', car[, 7, drop = FALSE]), car, smooth = 1)
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
r <- cv(list(a, b), car, k = 10, dag = FALSE)
expect_equal(r, c(0.8582183, 0.7002446), tolerance = 1e-7)
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
s <- cv(list(a, b), car, k = 10, dag = FALSE)
expect_equal(s, r)
})
test_that("CV a wrapper", {
skip_on_cran()
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
t <- tan_hc('class', car, k = 2, epsilon = 0, smooth = 0.01)
t <- lp(t, car, smooth = 0.01)
r <- cv(t, car, k = 2, dag = TRUE)
expect_equal(r, 0.9346065, tolerance = 1e-7)
})
test_that("CV aode", {
skip_on_cran()
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
t <- aode('class', car)
t <- lp(t, car, smooth = 0.01)
r <- cv(t, car, k = 2, dag = TRUE)
expect_equal(r, 0.9056713, tolerance = 1e-7) # just regression test, comparing value I obtained on first run
})
test_that("correct cv result", {
skip_on_cran()
t <- tan_hc('class', car, k = 5, epsilon = 0, smooth = 0.12)
t <- lp(t, car, smooth = 0.01)
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
s <- cv(t, car, k = 5, dag = TRUE)
expect_equal(s, 0.9415345, tolerance = 1e-6)
})
test_that("cv with different parameter learning", {
a <- lp(nb('class', car), car, smooth = 1)
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
b <- lp(nb('class', car), car, smooth = 1, awnb_trees = 10)
d <- lp(nb('class', car), car, smooth = 1, manb_prior = 0.1)
r <- cv(list(a, b, d), car, k = 5, dag = FALSE)
expect_true(r[1] > r[2])
expect_true(r[3] > r[2])
expect_true(r[1] > r[3])
})
test_that("correct cv result with missing data", {
skip_on_cran()
skip_if_not_installed('gRain')
nb <- nbvote()
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
s <- cv(nb, voting, k = 5, dag = TRUE)
expect_equal(s, 0.9014301, tolerance = 1e-6)
})
test_that("cv with just-class classifier", {
skip_on_cran()
a <- lp(nb('class', car), car, smooth = 1)
b <- lp(nb('class', car[, 'class', drop = FALSE]), car, smooth = 1)
d <- lp(nb('class', car[, c(sample(1:6, 4), 7), drop=FALSE]), car, smooth=1)
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
r <- cv(list(a, b, d), car, k = 10, dag = TRUE)
})
test_that("learn and asses nominal", {
n <- nbcar()
mem_cpt <- make_cpts_cache(car, smooth = 1)
a <- learn_and_assess(mem_cpt, car, n)
p <- accuracy(predict(n, car), car$class)
expect_equal(a, p)
})
test_that("cv fixed partition", {
n <- nbcar()
mem_cpt <- make_cpts_cache(car, smooth = 1)
a <- cv_lp_partition(n, list(mem_cpt, mem_cpt), list(car, car))
p <- accuracy(predict(n, car), car$class)
expect_equal(a, p)
d <- tan_cl('class', car)
a <- cv_lp_partition(list(n, d), list(mem_cpt, mem_cpt), list(car, car))
p <- accuracy(predict(n, car), car$class)
g <- accuracy(predict(lp(d, car, smooth = 1), car), car$class)
expect_equal(a, c(p, g))
})
test_that("make folds nominal", {
test_make_stratified <- function() {
f <- make_stratified_folds(car$class, 3)
tf <- sapply(f, length)
expect_true(max(tf) < 578, min(tf) > 574)
tbl <- function(a) {
table(car$class[a])
}
a <- lapply(f, tbl)
diffs <- sum(abs(a[[1]] - a[[2]]), abs(a[[1]] - a[[3]]))
expect_true(diffs <= 5)
}
replicate(10, test_make_stratified)
})
test_that("make folds empty class", {
car_cv <- car[1:300, ]
f <- make_stratified_folds(car_cv$class, 2)
a <- table(car$class[f[[1]]])
b <- table(car$class[f[[2]]])
expect_equal(sum(abs(a - b)), 0)
})
test_that("distribute accross folds nominal", {
suppressWarnings(RNGversion("3.5.0"))
set.seed(4)
f <- distribute_class_over_folds(1210, 3)
expect_true(all(table(f) == c(403, 404, 403)))
expect_error(f <- distribute_class_over_folds(1, 1))
f <- distribute_class_over_folds(4, 4)
expect_equal(sort(f), 1:4)
f <- distribute_class_over_folds(1, 2)
expect_equal(f, 1)
f <- distribute_class_over_folds(4, 1200)
expect_equal(f, c(733, 485, 899, 857))
f <- distribute_class_over_folds(0, 2)
expect_equal(f, integer())
})
test_that("cv of different models", {
skip_on_cran()
t <- kdb('class', dataset = car, kdb = 1, k = 10, epsilon = 0)
t <- lp(t, car, smooth = 1)
to <- tan_hc('class', dataset = car, k = 10, epsilon = 0)
to <- lp(to, car, smooth = 1)
suppressWarnings(RNGversion("3.5.0"))
set.seed(0)
score <- cv(list(t, to), car, k = 2)
expect_false(isTRUE(all.equal(score[1], score[2])))
})
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.