tests/testthat/test-simulation.R

In robertness/bninfo: Queries and information theoritic operations on Bayesian networks.

context("simulation")

node_names <- names(learning.test)
net_struct <- empty.graph(node_names)
modelstring(net_struct) <- "[A][C][F][B|A][D|A:C][E|B:F]"
net <- bn.fit(net_struct, learning.test, method = "bayes")
sim_data <- rbn(net, 600)
fixed_data <- lapply(node_names, fix_node,
                     fitted_net = net, level = "a", n = 100) %>%
                     {do.call("rbind", .)}
int_data <- rbn_inhibition(net, n = 100, node_names)
exp <- lapply(node_names, function(item) which(attr(int_data, "target") == item))
names(exp) <- node_names

test_that("bde score should be better for fixed sim than random sim since it should
          achieve a broader sampling of the space", {
    expect_true(score(net_struct, fixed_data, type = "bde") > score(net_struct, sim_data, type = "bde"))
})

test_that("bde score should be worse for int data since it is based on mutilated graphs",{
  expect_true(score(net_struct, fixed_data, type = "bde") > score(net_struct, int_data, type = "bde"))
})

test_that("mbde score on int data should be better than bde on int data, since
          mbde should reflect the mutilations.",{
            expect_true(score(net_struct, int_data, type = "mbde", exp = exp) > score(net_struct, int_data, type = "bde"))
})

test_that("mbde score for int data should be better than bde for fixed data
          since they reflect the same system but mbde incorporates causal information",{
            expect_true(score(net_struct, fixed_data, type = "bde") < score(net_struct, int_data, type = "mbde", exp = exp))
})

test_that("Orientation entropy and L1 error should be lower for graph inferred on int data since
          includes experimental information in the inference", {
            fixed_boot <- boot_dags(fixed_data, algorithm = "tabu", R = 200,
                                    algorithm.args = list(tabu = 50, score = "bde"),
                                    random.graph.args = list(method = "ic-dag", every = 88)) %>%
              custom.strength(node_names)
            fixed_entropy <- sum(orientation_entropy(fixed_boot))
            fixed_l1 <- l1_error(fixed_boot, net)
            int_boot <- boot_dags(int_data, algorithm = "tabu", R = 200,
                                  algorithm.args = list(tabu = 50, score = "mbde", exp = exp),
                                  random.graph.args = list(method = "ic-dag", every = 88)) %>%
              custom.strength(node_names)
            int_entropy <- sum(orientation_entropy(int_boot))
            int_l1 <- l1_error(int_boot, net)
            expect_true(int_entropy < fixed_entropy)
            expect_true(int_l1 < fixed_l1)
})