test-scc_utils.R
In epicmodel: Causal Modeling in Epidemiology

test_that("split_prc works", {
  expect_error(split_prc(NULL), class = "input_prc")
  expect_error(split_prc(NA), class = "input_prc")

  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_error(split_prc(steplist_party_test$step), class = "input_prc")

  steplist_mini_and_prc <- readRDS(test_path("fixtures", "steplist_mini_and.rds")) %>% process_steplist()
  expect_equal(split_prc(steplist_mini_and_prc) %>% magrittr::extract2("non_start_steps"),
               steplist_mini_and_prc %>% dplyr::filter(id_step == "IFa1+a2THENa3"))
  expect_equal(split_prc(steplist_mini_and_prc) %>% magrittr::extract2("causes"),
               steplist_mini_and_prc %>% dplyr::filter(id_step %in% c("THENa1","THENa2")))
  expect_equal(split_prc(steplist_mini_and_prc) %>% magrittr::extract2("interventions"),
               steplist_mini_and_prc %>% dplyr::filter(id_step == "aaa"))
  expect_equal(split_prc(steplist_mini_and_prc) %>% magrittr::extract2("ifnot_steps"), character(0))
  expect_equal(split_prc(steplist_mini_and_prc) %>% magrittr::extract2("end_steps"), c("IFa1+a2THENa3"))

  steplist_mini_depends_prc <- readRDS(test_path("fixtures", "steplist_mini_depends.rds")) %>% process_steplist()
  expect_equal(split_prc(steplist_mini_depends_prc) %>% magrittr::extract2("non_start_steps"),
               steplist_mini_depends_prc %>% dplyr::filter(id_step %in% c("IFa1IFNOTa2THENa3","IFa2+a3THENa4")))
  expect_equal(split_prc(steplist_mini_depends_prc) %>% magrittr::extract2("causes"),
               steplist_mini_depends_prc %>% dplyr::filter(id_step %in% c("THENa1","THENa2")))
  expect_equal(split_prc(steplist_mini_depends_prc) %>% magrittr::extract2("interventions"),
               steplist_mini_depends_prc %>% dplyr::filter(id_step == "aaa"))
  expect_equal(split_prc(steplist_mini_depends_prc) %>% magrittr::extract2("ifnot_steps"), c("IFa1IFNOTa2THENa3"))
  expect_equal(split_prc(steplist_mini_depends_prc) %>% magrittr::extract2("end_steps"), c("IFa2+a3THENa4"))

  steplist_mini_implau_prc <- readRDS(test_path("fixtures", "steplist_mini_implau.rds")) %>% process_steplist()
  expect_equal(split_prc(steplist_mini_implau_prc) %>% magrittr::extract2("non_start_steps"),
               steplist_mini_implau_prc %>% dplyr::filter(id_step %in% c("IFa2IFNOTa3THENa5","IFa1IFNOTa5THENa4","IFa4+a5+a3THENa6")))
  expect_equal(split_prc(steplist_mini_implau_prc) %>% magrittr::extract2("causes"),
               steplist_mini_implau_prc %>% dplyr::filter(id_step %in% c("THENa1","THENa2","THENa3")))
  expect_equal(split_prc(steplist_mini_implau_prc) %>% magrittr::extract2("interventions"),
               steplist_mini_implau_prc %>% dplyr::filter(id_step == "aaa"))
  expect_equal(split_prc(steplist_mini_implau_prc) %>% magrittr::extract2("ifnot_steps"), c("IFa2IFNOTa3THENa5","IFa1IFNOTa5THENa4"))
  expect_equal(split_prc(steplist_mini_implau_prc) %>% magrittr::extract2("end_steps"), c("IFa4+a5+a3THENa6"))

  steplist_mini_intv_to_depends_prc <- readRDS(test_path("fixtures", "steplist_mini_intv_to_depends.rds")) %>% process_steplist()
  expect_equal(split_prc(steplist_mini_intv_to_depends_prc) %>% magrittr::extract2("non_start_steps"),
               steplist_mini_intv_to_depends_prc %>% dplyr::filter(id_step %in% c("IFa1IFNOTa2THENa4","IF(a4+a2)or(a3)THENa5")))
  expect_equal(split_prc(steplist_mini_intv_to_depends_prc) %>% magrittr::extract2("causes"),
               steplist_mini_intv_to_depends_prc %>% dplyr::filter(id_step %in% c("THENa2","IFNOTa7THENa3","IFNOTa6THENa1")))
  expect_equal(split_prc(steplist_mini_intv_to_depends_prc) %>% magrittr::extract2("interventions"),
               steplist_mini_intv_to_depends_prc %>% dplyr::filter(id_step %in% c("THENa6","THENa7")))
  expect_equal(split_prc(steplist_mini_intv_to_depends_prc) %>% magrittr::extract2("ifnot_steps"),
               c("IFNOTa7THENa3","IFNOTa6THENa1","IFa1IFNOTa2THENa4"))
  expect_equal(split_prc(steplist_mini_intv_to_depends_prc) %>% magrittr::extract2("end_steps"), c("IF(a4+a2)or(a3)THENa5"))

  steplist_mini_intv_prc <- readRDS(test_path("fixtures", "steplist_mini_intv.rds")) %>% process_steplist()
  expect_equal(split_prc(steplist_mini_intv_prc) %>% magrittr::extract2("non_start_steps"),
               steplist_mini_intv_prc %>% dplyr::filter(id_step %in% c("IFa1IFNOTa2THENa3")))
  expect_equal(split_prc(steplist_mini_intv_prc) %>% magrittr::extract2("causes"),
               steplist_mini_intv_prc %>% dplyr::filter(id_step %in% c("THENa1")))
  expect_equal(split_prc(steplist_mini_intv_prc) %>% magrittr::extract2("interventions"),
               steplist_mini_intv_prc %>% dplyr::filter(id_step %in% c("THENa2")))
  expect_equal(split_prc(steplist_mini_intv_prc) %>% magrittr::extract2("ifnot_steps"), c("IFa1IFNOTa2THENa3"))
  expect_equal(split_prc(steplist_mini_intv_prc) %>% magrittr::extract2("end_steps"), c("IFa1IFNOTa2THENa3"))
})

test_that("get_cause_combinations works", {
  steplist_mini_and <- readRDS(test_path("fixtures", "steplist_mini_and.rds")) %>% check_steplist()
  causes_mini_and <- steplist_mini_and %>% process_steplist() %>% split_prc() %>% magrittr::extract2("causes")

  cc_mini_and <- data.frame(THENa1 = c(F,T,T), THENa2 = c(T,F,T)) %>% magrittr::set_rownames(paste0("cc",1:3))
  expect_equal(get_cause_combinations(causes_mini_and, steplist_mini_and) %>% magrittr::set_attr("out.attrs", NULL), cc_mini_and)
})

test_that("transform_outc & transform_outc_list work", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds")) %>% remove_na() %>% remove_segment("d4") %>% check_steplist()
  outc_party_test <- data.frame(sce = c("1","1","1","1"), id = c("a4d5","a9d6","a6d5","a2d6"))
  expect_equal(transform_outc(steplist_party_test), outc_party_test)

  outc_party_test <- transform_outc(steplist_party_test)
  outc_compare <- "c('a4d5','a9d6','a6d5','a2d6') %>% magrittr::is_in(final_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0)"
  expect_equal(transform_outc_list(outc_party_test), outc_compare)
})

test_that("transform_if_list works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  steplist_party_test_prc <- steplist_party_test %>% process_steplist()

  expect_error(transform_if_list(steplist_party_test_prc$if_list[1][[1]]), class = "input_if_list")
  str1 <- "c('a5d1') %>% magrittr::is_in(current_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0)"
  expect_equal(transform_if_list(steplist_party_test_prc$if_list[5][[1]]), str1)
  str2 <- paste0("c('a7d3e2') %>% magrittr::is_in(current_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0) | c('a7d3e1','a3')",
                 " %>% magrittr::is_in(current_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0)")
  expect_equal(transform_if_list(steplist_party_test_prc$if_list[9][[1]]), str2)
  str3 <- paste0("c('a7d3e5') %>% magrittr::is_in(current_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0) | c('a7d3e4') %>% ",
                 "magrittr::is_in(current_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0)")
  expect_equal(transform_if_list(steplist_party_test_prc$if_list[10][[1]]), str3)
  str4 <- paste0("c('a4d1','a5d5') %>% magrittr::is_in(current_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0)",
                 " | c('a4d1','a7d3e5') %>% magrittr::is_in(current_list_then) %>% magrittr::not() %>% sum() %>% magrittr::equals(0)")
  expect_equal(transform_if_list(steplist_party_test_prc$if_list[14][[1]]), str4)
})

test_that("is_fulfilled works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  steplist_party_test_prc <- steplist_party_test %>% process_steplist()

  if_list1 <- steplist_party_test_prc$if_list[14][[1]]
  current_list1 <- c("a4d1","a5d5")
  current_list2 <- c("a5d5","a7d3e5")
  current_list3 <- c("a7d3e5","a4d1")
  expect_true(is_fulfilled(if_list1, current_list1))
  expect_false(is_fulfilled(if_list1, current_list2))
  expect_true(is_fulfilled(if_list1, current_list3))
})

test_that("is_fulfilled_outc works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds")) %>% remove_na() %>% remove_segment("d4") %>% check_steplist()
  outc_party_test <- transform_outc(steplist_party_test)

  final_list_then1 <- c("a4d5","a9d6","a6d5","a2d6","abc")
  final_list_then2 <- c("a4d5","a9d6","a6d5")
  final_list_then3 <- c("a5d5","a7d3e5")
  expect_true(is_fulfilled_outc(outc_party_test, final_list_then1))
  expect_false(is_fulfilled_outc(outc_party_test, final_list_then2))
  expect_false(is_fulfilled_outc(outc_party_test, final_list_then3))
})

test_that("next_round_of_steps works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  steplist_party_test_prc <- steplist_party_test %>% process_steplist()

  current_list_then1 <- c("a5d1","a4d1")
  steps_left1 <- steplist_party_test_prc %>% dplyr::filter(!(.data$then_step %in% current_list_then1)) %>% dplyr::filter(!is.na(if_step))
  expect_equal(next_round_of_steps(steps_left1, current_list_then1), c("IFa5d1IFNOTa7d3e3THENa5d5"))

  current_list_then2 <- c("a5d1","a4d1","a5d5")
  steps_left2 <- steplist_party_test_prc %>% dplyr::filter(!(.data$then_step %in% current_list_then2)) %>% dplyr::filter(!is.na(if_step))
  expect_equal(next_round_of_steps(steps_left2, current_list_then2), c("IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5"))

  current_list_then3 <- c("a5d1","a4d1","a7d3e5")
  steps_left3 <- steplist_party_test_prc %>% dplyr::filter(!(.data$then_step %in% current_list_then3)) %>% dplyr::filter(!is.na(if_step))
  expect_equal(next_round_of_steps(steps_left3, current_list_then3),
               c("IFa5d1IFNOTa7d3e3THENa5d5","IF(a7d3e5)or(a7d3e4)THENa7d3e2","IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5"))
})

test_that("is_sufficient works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds")) %>% remove_na() %>% remove_segment("d4") %>% check_steplist()
  outc_party_test <- transform_outc(steplist_party_test)
  steplist_party_test_split <- steplist_party_test %>% process_steplist() %>% split_prc()
  cc <- get_cause_combinations(steplist_party_test_split$causes, steplist_party_test)

  #c("THENa5d1","THENa4d1","THENa6d1","THENa3","THENa7d3e4")
  suff1 <- is_sufficient(cc, row = 122, non_start_steps = steplist_party_test_split$non_start_steps, outc_party_test)
  expect_true(suff1$is_suff)
  expect_equal(suff1$final_list, c("THENa5d1","THENa4d1","THENa6d1","THENa3","THENa7d3e4","IFa5d1IFNOTa7d3e3THENa5d5",
                                   "IF(a7d3e5)or(a7d3e4)THENa7d3e2","IFa6d1THENa6d5","IF(a7d3e4)or(a8d2a1)THENa9d6",
                                   "IF(a7d3e2)or(a7d3e1+a3)THENa2d6","IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5"))

  #c("THENa4d1","THENa6d1","THENa7d3e5")
  suff2 <- is_sufficient(cc, row = 51, non_start_steps = steplist_party_test_split$non_start_steps, outc_party_test)
  expect_false(suff2$is_suff)
  expect_equal(suff2$final_list, c("THENa4d1","THENa6d1","THENa7d3e5","IF(a7d3e5)or(a7d3e4)THENa7d3e2","IFa6d1THENa6d5",
                                   "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5","IF(a7d3e2)or(a7d3e1+a3)THENa2d6"))
})

test_that("minimize_sc works", {
  steplist_rain_test <- readRDS(test_path("fixtures", "steplist_rain_test.rds")) %>% check_steplist()
  causes_rain_test <- steplist_rain_test %>% process_steplist() %>% split_prc() %>% magrittr::extract2("causes")

  cc <- get_cause_combinations(causes_rain_test, steplist_rain_test)

  cc_compare1 <- cc[1:4,]
  expect_equal(minimize_sc(cc), cc_compare1)

  cc2 <- cc[3:15,]
  cc_compare2 <- cc[c(3:5),]
  expect_equal(minimize_sc(cc2), cc_compare2)
})

test_that("get_sc_to_check_for_ifnot & check_ifnot work", {
  sc_test <- data.frame(THENa5d1 = c(F,T,F,T,T,T,T,T,T),
                   THENa4d1 = c(T,T,T,T,T,T,T,T,T),
                   THENa6d1 = c(T,T,T,T,T,T,T,T,T),
                   THENa7d3e3 = c(T,F,T,T,F,T,T,T,T),
                   THENa3 = c(F,F,T,F,T,F,T,T,T),
                   THENa7d3e4 = c(F,T,F,F,T,T,F,F,T),
                   THENa7d3e5 = c(T,F,T,T,F,F,F,T,F),
                   THENa7d3e6 = c(F,F,F,F,F,F,T,F,F)) %>%
    magrittr::set_rownames(c("cc90", "cc103", "cc114", "cc118", "cc122", "cc123", "cc125", "cc126", "cc127"))

  sc_final_steps_test <- list(cc90 = c("THENa4d1", "THENa6d1", "THENa7d3e3", "THENa7d3e5", "IF(a7d3e5)or(a7d3e4)THENa7d3e2", "IFa6d1THENa6d5",
                                       "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5", "IFa7d3e3THENa8d2a1", "IF(a7d3e2)or(a7d3e1+a3)THENa2d6",
                                       "IF(a7d3e4)or(a8d2a1)THENa9d6"),
                              cc103 = c("THENa5d1", "THENa4d1", "THENa6d1", "THENa7d3e4", "IFa5d1IFNOTa7d3e3THENa5d5",
                                        "IF(a7d3e5)or(a7d3e4)THENa7d3e2", "IFa6d1THENa6d5", "IF(a7d3e4)or(a8d2a1)THENa9d6",
                                        "IF(a7d3e2)or(a7d3e1+a3)THENa2d6", "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5"),
                              cc114 = c("THENa4d1", "THENa6d1", "THENa7d3e3", "THENa3", "THENa7d3e5", "IF(a7d3e5)or(a7d3e4)THENa7d3e2",
                                        "IFa6d1THENa6d5", "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5", "IFa7d3e3THENa8d2a1",
                                        "IF(a7d3e2)or(a7d3e1+a3)THENa2d6", "IF(a7d3e4)or(a8d2a1)THENa9d6"),
                              cc118 = c("THENa5d1", "THENa4d1", "THENa6d1", "THENa7d3e3", "THENa7d3e5", "IFa5d1IFNOTa7d3e3THENa5d5",
                                        "IF(a7d3e5)or(a7d3e4)THENa7d3e2", "IFa6d1THENa6d5", "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5",
                                        "IFa7d3e3THENa8d2a1", "IF(a7d3e2)or(a7d3e1+a3)THENa2d6", "IF(a7d3e4)or(a8d2a1)THENa9d6"),
                              cc122 = c("THENa5d1", "THENa4d1", "THENa6d1", "THENa3", "THENa7d3e4", "IFa5d1IFNOTa7d3e3THENa5d5",
                                        "IF(a7d3e5)or(a7d3e4)THENa7d3e2", "IFa6d1THENa6d5", "IF(a7d3e4)or(a8d2a1)THENa9d6",
                                        "IF(a7d3e2)or(a7d3e1+a3)THENa2d6", "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5"),
                              cc123 = c("THENa5d1", "THENa4d1", "THENa6d1", "THENa7d3e3", "THENa7d3e4", "IFa5d1IFNOTa7d3e3THENa5d5",
                                        "IF(a7d3e5)or(a7d3e4)THENa7d3e2", "IFa6d1THENa6d5", "IFa7d3e3THENa8d2a1", "IF(a7d3e4)or(a8d2a1)THENa9d6",
                                        "IF(a7d3e2)or(a7d3e1+a3)THENa2d6", "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5"),
                              cc125 = c("THENa5d1", "THENa4d1", "THENa6d1", "THENa7d3e3", "THENa3", "THENa7d3e6", "IFa5d1IFNOTa7d3e3THENa5d5",
                                        "IFa7d3e6THENa7d3e1", "IFa6d1THENa6d5", "IFa7d3e3THENa8d2a1", "IF(a7d3e2)or(a7d3e1+a3)THENa2d6",
                                        "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5", "IF(a7d3e4)or(a8d2a1)THENa9d6"),
                              cc126 = c("THENa5d1", "THENa4d1", "THENa6d1", "THENa7d3e3", "THENa3", "THENa7d3e5", "IFa5d1IFNOTa7d3e3THENa5d5",
                                        "IF(a7d3e5)or(a7d3e4)THENa7d3e2", "IFa6d1THENa6d5", "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5",
                                        "IFa7d3e3THENa8d2a1", "IF(a7d3e2)or(a7d3e1+a3)THENa2d6", "IF(a7d3e4)or(a8d2a1)THENa9d6"),
                              cc127 = c("THENa5d1", "THENa4d1", "THENa6d1", "THENa7d3e3", "THENa3", "THENa7d3e4", "IFa5d1IFNOTa7d3e3THENa5d5",
                                        "IF(a7d3e5)or(a7d3e4)THENa7d3e2", "IFa6d1THENa6d5", "IFa7d3e3THENa8d2a1", "IF(a7d3e4)or(a8d2a1)THENa9d6",
                                        "IF(a7d3e2)or(a7d3e1+a3)THENa2d6", "IF(a4d1+a5d5)or(a4d1+a7d3e5)THENa4d5"))

  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds")) %>% remove_na() %>% remove_segment("d4") %>% check_steplist()
  steplist_party_test_prc <- steplist_party_test %>% process_steplist()
  steplist_party_test_split <- steplist_party_test %>% process_steplist() %>% split_prc()
  outc_party_test <- transform_outc(steplist_party_test)

  compare <- data.frame(THENa5d1 = c(T,T,T,T,T,T,T),
                        THENa4d1 = c(T,T,T,T,T,T,T),
                        THENa6d1 = c(T,T,T,T,T,T,T),
                        THENa7d3e3 = c(F,T,F,T,T,T,T),
                        THENa3 = c(F,F,T,F,T,T,T),
                        THENa7d3e4 = c(T,F,T,T,F,F,T),
                        THENa7d3e5 = c(F,T,F,F,F,T,F),
                        THENa7d3e6 = c(F,F,F,F,T,F,F)) %>%
    magrittr::set_rownames(c("cc103", "cc118", "cc122", "cc123", "cc125", "cc126", "cc127"))

  expect_equal(get_sc_to_check_for_ifnot(sc_test, sc_final_steps_test, steplist_party_test_split$ifnot_steps), compare)

  check1 <- check_ifnot(re_sc = compare, row = 1, sc_final_steps = sc_final_steps_test, prc = steplist_party_test_prc,
                        prc_split = steplist_party_test_split, outc_list = outc_party_test)
  expect_equal(check1$sc_status, "always")
  expect_equal(check1$order, NA)
  expect_false(check1$incon)
  expect_equal(check1$incon_then, NA)

  check2 <- check_ifnot(re_sc = compare, row = 5, sc_final_steps = sc_final_steps_test, prc = steplist_party_test_prc,
                        prc_split = steplist_party_test_split, outc_list = outc_party_test)
  expect_equal(check2$sc_status, "depends")
  order2 <- data.frame(order = c("a5d1->a7d3e3","a7d3e3->a5d1"), suff = c(T,F))
  expect_equal(check2$order, order2)
  expect_false(check2$incon)
  expect_equal(check2$incon_then, NA)
})

test_that("unknown_sc works", {
  sc_in <- data.frame(THENa1 = c(T,F), THENa2 = c(T,T), THENa3 = c(F,T)) %>% magrittr::set_rownames(c("cc2","cc7"))
  sc_out <- data.frame(THENa1 = c(T,F,F), THENa2 = c(T,T,F), THENa3 = c(F,T,F), U1 = c(T,F,F), U2 = c(F,T,F), USC = c(F,F,T)) %>%
    magrittr::set_rownames(c("cc2","cc7","cc0"))

  expect_equal(unknown_sc(sc_in), sc_out)
})