test_that("tpc causalDisco arguments to tfci_run can be passed along correctly", { data(tpc_example) my_tpc <- tpc(engine = "causalDisco", test = "fisher_z", method = "stable") expect_no_warning(disco(tpc_example, my_tpc)) }) test_that("tpc causalDisco respects tier knowledge", { data(tpc_example) kn <- knowledge( tpc_example, tier( child ~ starts_with("child"), youth ~ starts_with("youth"), old ~ starts_with("old") ) ) my_tpc <- tpc(engine = "causalDisco", test = "fisher_z") output <- disco(tpc_example, my_tpc, knowledge = kn) edges <- output$caugi@edges violations <- causalDisco:::check_tier_violations(edges, kn) expect_true( nrow(violations) == 0, info = "Tier violations were found in the output graph." ) kn <- knowledge( tpc_example, tier( 1 ~ starts_with("old"), 2 ~ starts_with("youth"), 3 ~ starts_with("child") ) ) my_tpc <- tpc(engine = "causalDisco", test = "fisher_z") output <- disco(tpc_example, my_tpc, knowledge = kn) edges <- output$caugi@edges violations <- causalDisco:::check_tier_violations(edges, kn) expect_true( nrow(violations) == 0, info = "Tier violations were found in the output graph." ) }) test_that("tpc causalDisco respects required background knowledge", { data(tpc_example) kn <- knowledge( tpc_example, child_x1 %-->% youth_x3 ) my_tpc <- tpc(engine = "causalDisco", test = "fisher_z") out <- expect_warning( disco(data = tpc_example, method = my_tpc, knowledge = kn), "causalDisco engine does not support required edges in knowledge." ) skip( "tpc causalDisco does not yet support required edges from knowledge objects." ) edges <- out$caugi@edges violations <- causalDisco:::check_edge_constraints(edges, kn) expect_true( nrow(violations) == 0, info = "Required edge not found in the output graph." ) kn <- knowledge( tpc_example, child_x1 %-->% youth_x3, child_x2 %-->% child_x1 ) my_tpc <- tpc(engine = "causalDisco", test = "fisher_z") out <- disco(data = tpc_example, method = my_tpc, knowledge = kn) edges <- out$caugi@edges violations <- causalDisco:::check_edge_constraints(edges, kn) expect_true( nrow(violations) == 0, info = "Required edge not found in the output graph." ) }) test_that("tpc causalDisco respects forbidden background knowledge", { data(tpc_example) kn <- knowledge( tpc_example, child_x2 %!-->% oldage_x5 ) my_tpc <- tpc(engine = "causalDisco", test = "fisher_z") out <- disco(data = tpc_example, method = my_tpc, knowledge = kn) edges <- out$caugi@edges violations <- causalDisco:::check_edge_constraints(edges, kn) expect_true( nrow(violations) == 0, info = "Forbidden edges were found in the output graph." ) # edges contains oldage_x6 -> oldage_x5. Verify graph changes when we forbid oldage_x5 -> oldage_x6. kn <- knowledge( tpc_example, child_x2 %!-->% oldage_x5, oldage_x5 %!-->% oldage_x6 ) my_tpc <- tpc(engine = "causalDisco", test = "fisher_z") out <- disco(data = tpc_example, method = my_tpc, knowledge = kn) edges <- out$caugi@edges violations <- causalDisco:::check_edge_constraints(edges, kn) expect_true( nrow(violations) == 0, info = "Forbidden edges were found in the output graph." ) })