tests/testthat/test-learn-chowliu.R

In bmihaljevic/bnclassify: Learning Discrete Bayesian Network Classifiers from Data

context("Chow-Liu")

check_cl <- function(x, nedges, class, features) {
  expect_is(x, "bnc_dag")
  expect_equal(narcs(x), nedges)
  expect_equal(class_var(x), class)
  expect_true(is_perm(features(x), features))
}

test_that("chowliu nominal car", {
  cl <- chowliu(class = 'class', dataset = car)
  check_cl(cl, 6 + 5, 'class', colnames(car)[-7])
})  

test_that("chowliu nominal voting", {  
  cl <- chowliu(class = 'Class', dataset = voting)
  check_cl(cl, 16 + 15, 'Class', colnames(voting)[-17])
})

test_that("chowliu No features", {
  cl <- chowliu(class = 'Class', dataset = voting[ , 17, drop=F])
  check_cl(cl, 0, 'Class', character()) 
})

test_that("chowliu bic car", {
  t <- chowliu(class = 'class', dataset = car, score = "bic")
  check_cl(t, 6, 'class', colnames(car)[-7])   
})

test_that("chowliu bic voting", {
  t <- chowliu(class = 'Class', dataset = voting, score = "bic")
  check_cl(t, 30, 'Class', colnames(voting)[-17])   
  expect_equal(families(t)[['immigration']], c('immigration', 'Class'))
})

#   t <- chowliu(class = 'Class', dataset = dbreast, score = "bic")
#   expect_equal(narcs(t), 13) 

test_that("chowliu single-row dataset", {
  t <- chowliu(class = 'class', dataset = car[1, ], score = "loglik")
  expect_equal(narcs(t), 11)
})

test_that("pairwise local scores nominal", {  
  a <- pairwise_ode_score_contribs(class = 'class', dataset = car, score= "loglik")  
  w <- graph_get_named_weights(a) 
  b <- subset(w, from == 'maint' & to == 'safety')['w']
  cmi <- cmi("maint", "safety", car, 'class')
  expect_equal(unname(unlist(b)), cmi, tolerance = 0.0001)
  expect_true(all(unlist(w) > 0))  
})

test_that("pairwise local scores No features", {  
  a <- pairwise_ode_score_contribs(class = 'class', dataset = car[,7, drop=F], 
                           score = "loglik")
  expect_equal(a, graph_internal(edgemode = "undirected"))
# No weights kept. 
  a <- pairwise_ode_score_contribs(class = 'class', dataset = car, score = "bic")  
  w <- a$weights
  expect_equal(graph_nodes(a), colnames(car)[-7])
  expect_equal(length(unlist(w)), 0L)
})

test_that("pairwise local scores bic", {  
  t <- pairwise_ode_score_contribs(class = 'class', dataset = car, score = "bic")    
  expect_equal(graph_num_arcs(t), 0)
})

test_that("local scores correctness", {  
  a <- local_ode_score_contrib(x = 'buying', y = 'maint', class = 'class', 
                               dataset = car)
  expect_equal(unname(a['loglik']), 0.07199921, tolerance = 0.0001)
  expect_true(a['bic'] < a['aic'])    
  
  a <- local_ode_score_contrib(x = 'water_project_cost_sharing', y = 'crime', 
                     class = 'Class', dataset = voting)  
  expect_equal(unname(a['loglik']), 0.003924715, tolerance = 0.0001)
  expect_true(a['bic'] < a['aic'])      
})

test_that("local scores bic correctness", {
  v <- na.omit(voting)
  scores <- local_ode_score_contrib(x = 'handicapped_infants', 
                            y = 'water_project_cost_sharing', class = 'Class',
                            dataset = v)
  # I know the correct value; see correctness-checks.R
  expect_equal(scores[['bic']], -4.280159, tolerance = 1e-5)
})

test_that("Max weight forest", {   
  g <- pairwise_ode_score_contribs(class = 'Class', voting, score = 'loglik')
  u <- max_weight_forest(g)
  expect_equal(graph_num_arcs(u), 15)  
  
  g <- pairwise_ode_score_contribs(class = 'class', dataset = car, 
                                   score = "loglik")
  u <- max_weight_forest(g)
  expect_equal(graph_num_arcs(u), 5)  
  
# Forest
  g <- pairwise_ode_score_contribs(class = 'class', dataset = car, 
                                   score = "aic")
  u <- max_weight_forest(g)
  expect_equal(graph_num_arcs(u), 3)  
})