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

test_that("scc_to_dag works", {
  steplist_party_test <- readRDS(test_path("fixtures", "steplist_party_test.rds"))
  expect_error(scc_to_dag(steplist_party_test), class = "no_scc")
  expect_error(scc_to_dag(scc = NULL), class = "no_scc")
  expect_error(scc_to_dag(scc = NA), class = "no_scc")
})

test_that("scc_to_dag mini_and", {
  steplist_mini_and <- readRDS(test_path("fixtures", "steplist_mini_and.rds")) %>% check_steplist()
  scc_mini_and <- steplist_mini_and %>% create_scc()

  expect_no_error(scc_mini_and %>% scc_to_dag(unknown = T))
  expect_no_error(scc_mini_and %>% scc_to_dag(unknown = F))

  dag <- dagitty::dagitty('dag {CC1 [pos="1.000,0.250"]
                                CC2 [pos="1.000,0.750"]
                                O [outcome,pos="4.000,0.500"]
                                SC1 [pos="3.000,0.000"]
                                USC [pos="3.000,1.000"]
                                U_SC1 [pos="2.000,0.000"]
                                U_USC [pos="2.000,1.000"]
                                CC1 -> SC1
                                CC2 -> SC1
                                SC1 -> O
                                USC -> O
                                U_SC1 -> SC1
                                U_USC -> USC
                              }')
  legend <- data.frame(desc = c("a1","a2"), label = c("CC1","CC2"))
  expect_equal(scc_mini_and %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag"), dag)
  expect_equal(scc_mini_and %>% scc_to_dag(unknown = T) %>% magrittr::extract2("legend"), legend)

  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(scc_mini_and %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag") %>% plot_dag())
  expect_error(scc_mini_and %>% scc_to_dag(unknown = T) %>% plot_dag(), class = "scc_to_dag_complete_list")
})

test_that("scc_to_dag mini_depends", {
  steplist_mini_depends <- readRDS(test_path("fixtures", "steplist_mini_depends.rds")) %>% check_steplist()
  scc_mini_depends <- steplist_mini_depends %>% create_scc()

  expect_no_error(scc_mini_depends %>% scc_to_dag(unknown = T))
  expect_no_error(scc_mini_depends %>% scc_to_dag(unknown = F))

  dag <- dagitty::dagitty('dag {CC1 [pos="1.000,0.250"]
                                CC2 [pos="1.000,0.750"]
                                O [outcome,pos="4.000,0.500"]
                                SC1 [pos="3.000,0.000"]
                                USC [pos="3.000,1.000"]
                                U_SC1 [pos="2.000,0.000"]
                                U_USC [pos="2.000,1.000"]
                                CC1 -> SC1
                                CC2 -> SC1
                                SC1 -> O
                                USC -> O
                                U_SC1 -> SC1
                                U_USC -> USC
                              }')
  legend <- data.frame(desc = c("a1","a2"), label = c("CC1","CC2"))
  expect_equal(scc_mini_depends %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag"), dag)
  expect_equal(scc_mini_depends %>% scc_to_dag(unknown = T) %>% magrittr::extract2("legend"), legend)

  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(scc_mini_depends %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag") %>% plot_dag())
})

test_that("scc_to_dag mini_implau", {
  steplist_mini_implau <- readRDS(test_path("fixtures", "steplist_mini_implau.rds")) %>% check_steplist()
  scc_mini_implau <- steplist_mini_implau %>% create_scc()

  expect_no_error(scc_mini_implau %>% scc_to_dag(unknown = T))
  expect_no_error(scc_mini_implau %>% scc_to_dag(unknown = F))

  dag <- dagitty::dagitty('dag {CC1 [pos="1.000,0.250"]
                                CC2 [pos="1.000,0.750"]
                                CC3 [pos="1.000,1.250"]
                                O [outcome,pos="4.000,0.750"]
                                SC1 [pos="3.000,0.000"]
                                USC [pos="3.000,1.500"]
                                U_SC1 [pos="2.000,0.000"]
                                U_USC [pos="2.000,1.500"]
                                CC1 -> SC1
                                CC2 -> SC1
                                CC3 -> SC1
                                SC1 -> O
                                USC -> O
                                U_SC1 -> SC1
                                U_USC -> USC
                              }')
  legend <- data.frame(desc = c("a1","a2","a3"), label = c("CC1","CC2","CC3"))
  expect_equal(scc_mini_implau %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag"), dag)
  expect_equal(scc_mini_implau %>% scc_to_dag(unknown = T) %>% magrittr::extract2("legend"), legend)

  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(scc_mini_implau %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag") %>% plot_dag())
})

test_that("scc_to_dag mini_intv", {
  steplist_mini_intv <- readRDS(test_path("fixtures", "steplist_mini_intv.rds")) %>% check_steplist()
  scc_mini_intv <- steplist_mini_intv %>% create_scc()

  expect_no_error(scc_mini_intv %>% scc_to_dag(unknown = T))
  expect_no_error(scc_mini_intv %>% scc_to_dag(unknown = F))

  dag <- dagitty::dagitty('dag {CC1 [pos="1.000,0.250"]
                                O [outcome,pos="3.000,0.250"]
                                SC1 [pos="2.000,0.000"]
                                CC1 -> SC1
                                SC1 -> O
                                }')
  legend <- data.frame(desc = c("a1"), label = c("CC1"))
  expect_equal(scc_mini_intv %>% scc_to_dag(unknown = F) %>% magrittr::extract2("dag"), dag)
  expect_equal(scc_mini_intv %>% scc_to_dag(unknown = F) %>% magrittr::extract2("legend"), legend)

  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(scc_mini_intv %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag") %>% plot_dag())
})

test_that("scc_to_dag mini_or", {
  steplist_mini_or <- readRDS(test_path("fixtures", "steplist_mini_or.rds")) %>% check_steplist()
  scc_mini_or <- steplist_mini_or %>% create_scc()

  expect_no_error(scc_mini_or %>% scc_to_dag(unknown = T))
  expect_no_error(scc_mini_or %>% scc_to_dag(unknown = F))

  dag <- dagitty::dagitty('dag {CC1 [pos="1.000,0.250"]
                                CC2 [pos="1.000,0.750"]
                                O [outcome,pos="4.000,0.500"]
                                SC1 [pos="3.000,0.000"]
                                SC2 [pos="3.000,0.500"]
                                USC [pos="3.000,1.000"]
                                U_SC1 [pos="2.000,0.000"]
                                U_SC2 [pos="2.000,0.500"]
                                U_USC [pos="2.000,1.000"]
                                CC1 -> SC1
                                CC2 -> SC2
                                SC1 -> O
                                SC2 -> O
                                USC -> O
                                U_SC1 -> SC1
                                U_SC2 -> SC2
                                U_USC -> USC
                              }')
  legend <- data.frame(desc = c("a2","a1"), label = c("CC1","CC2"))
  expect_equal(scc_mini_or %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag"), dag)
  expect_equal(scc_mini_or %>% scc_to_dag(unknown = T) %>% magrittr::extract2("legend"), legend)

  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(scc_mini_or %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag") %>% plot_dag())
})

test_that("scc_to_dag rain_test", {
  steplist_rain_test <- readRDS(test_path("fixtures", "steplist_rain_test.rds")) %>% check_steplist()
  scc_rain_test <- steplist_rain_test %>% create_scc()

  expect_no_error(scc_rain_test %>% scc_to_dag(unknown = T))
  expect_no_error(scc_rain_test %>% scc_to_dag(unknown = F))

  dag <- dagitty::dagitty('dag {CC1 [pos="1.000,0.250"]
                                CC2 [pos="1.000,0.750"]
                                CC3 [pos="1.000,1.250"]
                                CC4 [pos="1.000,1.750"]
                                O [outcome,pos="4.000,1.000"]
                                SC1 [pos="3.000,0.000"]
                                SC2 [pos="3.000,1.000"]
                                USC [pos="3.000,2.000"]
                                U_SC1 [pos="2.000,0.000"]
                                U_SC2 [pos="2.000,1.000"]
                                U_USC [pos="2.000,2.000"]
                                CC1 -> SC1
                                CC1 -> SC2
                                CC2 -> SC1
                                CC3 -> SC2
                                CC4 -> SC2
                                SC1 -> O
                                SC2 -> O
                                USC -> O
                                U_SC1 -> SC1
                                U_SC2 -> SC2
                                U_USC -> USC
                                }')
  legend <- data.frame(desc = c("rain","get groceries","no vacation","weekday"), label = c("CC1","CC2","CC3","CC4"))
  expect_equal(scc_rain_test %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag"), dag)
  expect_equal(scc_rain_test %>% scc_to_dag(unknown = T) %>% magrittr::extract2("legend"), legend)

  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(scc_rain_test %>% scc_to_dag(unknown = T) %>% magrittr::extract2("dag") %>% plot_dag())
})

test_that("plot_dag dag inputs work", {
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_error(plot_dag(dag = ""), class = "no_dag")
  expect_error(plot_dag(dag = NA), class = "no_dag")
  expect_error(plot_dag(dag = NULL), class = "no_dag")
  expect_error(plot_dag(dag = 'dag {E -> O}'), class = "no_dag")
})

test_that("plot_dag node & path input types are checked correctly", {
  dag1 <- dagitty::dagitty('dag {E -> O}')
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_error(plot_dag(dag1, node_outc = ""), class = "input_node_outc")
  expect_error(plot_dag(dag1, node_outc = NA), class = "input_node_outc")
  expect_error(plot_dag(dag1, node_outc = c("E","O")), class = "input_node_outc")
  expect_error(plot_dag(dag1, node_expo = ""), class = "input_node_expo")
  expect_error(plot_dag(dag1, node_expo = NA), class = "input_node_expo")
  expect_error(plot_dag(dag1, node_expo = c("E","O")), class = "input_node_expo")
  expect_error(plot_dag(dag1, node_adj = NA), class = "input_node_adj")
  expect_error(plot_dag(dag1, node_adj = ""), class = "input_node_adj")
  expect_error(plot_dag(dag1, node_adj = c("E","")), class = "input_node_adj")
  expect_error(plot_dag(dag1, node_latent = NA), class = "input_node_latent")
  expect_error(plot_dag(dag1, node_latent = ""), class = "input_node_latent")
  expect_error(plot_dag(dag1, node_latent = c("E","")), class = "input_node_latent")
  expect_error(plot_dag(dag1, path_causal = NA), class = "input_path_causal")
  expect_error(plot_dag(dag1, path_causal = ""), class = "input_path_causal")
  expect_error(plot_dag(dag1, path_causal = c("E->O","")), class = "input_path_causal")
  expect_error(plot_dag(dag1, path_biased = NA), class = "input_path_biased")
  expect_error(plot_dag(dag1, path_biased = ""), class = "input_path_biased")
  expect_error(plot_dag(dag1, path_biased = c("E->O","")), class = "input_path_biased")
})

test_that("plot_dag recognizes node overlaps", {
  dag1 <- dagitty::dagitty('dag {O [outcome] V1 -> O}')
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_error(plot_dag(dag1, node_outc = "V1"), class = "outc_exists")
  expect_error(plot_dag(dag1, node_expo = "X"), class = "input_node_expo_choices")
  expect_error(plot_dag(dag1, node_adj = "O"), class = "input_node_adj_choices")
  expect_error(plot_dag(dag1, node_adj = c("V1","V2")), class = "input_node_adj_choices")
  expect_error(plot_dag(dag1, node_latent = "O"), class = "input_node_latent_choices")
  expect_error(plot_dag(dag1, node_latent = c("V1","V2")), class = "input_node_latent_choices")
  dag2 <- dagitty::dagitty('dag {E [exposure] E -> V2}')
  expect_error(plot_dag(dag2, node_expo = "V2"), class = "expo_exists")
  expect_error(plot_dag(dag2, node_outc = "X"), class = "input_node_outc_choices")
  dag3 <- dagitty::dagitty('dag {E -> O}')
  expect_error(plot_dag(dag3, node_outc = "E", node_expo = "E"), class = "outc_equals_expo")
  expect_error(plot_dag(dag3, node_outc = "O", node_adj = "O"), class = "outc_in_adj")
  expect_error(plot_dag(dag3, node_adj = "E", node_expo = "E"), class = "expo_in_adj")
  expect_error(plot_dag(dag3, node_outc = "O", node_latent = "O"), class = "outc_in_latent")
  expect_error(plot_dag(dag3, node_latent = "E", node_expo = "E"), class = "expo_in_latent")
  expect_error(plot_dag(dag3, node_adj = "E", node_latent = c("E","O")), class = "node_adj_latent_overlap")
})

test_that("plot_dag recognizes path overlaps", {
  dag1 <- dagitty::dagitty('dag {V1 -> V2 ; V2 -> V3}')
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_error(plot_dag(dag1, path_causal = "V3->V4"), class = "input_path_causal_choices")
  expect_error(plot_dag(dag1, path_biased = "V3->V4"), class = "input_path_biased_choices")
  expect_error(plot_dag(dag1, path_causal = "V1->V2", path_biased = "V1->V2"), class = "path_causal_biased_overlap")
  expect_no_error(plot_dag(dag1, path_causal = "V1 -> V2"))
  expect_no_error(plot_dag(dag1, path_biased = "V1 -> V2"))
})

test_that("plot_dag labels work", {
  dag1 <- dagitty::dagitty('dag {V1 -> V2 ; V2 -> V3}')
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_error(plot_dag(dag1, label = c("a","b","c")), class = "input_label")
  expect_error(plot_dag(dag1, label = NA), class = "input_label")
  expect_error(plot_dag(dag1, label = c(V1 = "", V2 = "b")), class = "input_label")
  expect_error(plot_dag(dag1, label = c(V1 = NA, V2 = "b")), class = "input_label")
  expect_error(plot_dag(dag1, label = c(V1 = "a", V4 = "b")), class = "label_names")
  expect_error(plot_dag(dag1, label = c(V1 = "a", all = "b")), class = "label_names")
  expect_error(plot_dag(dag1, label = c(V1 = "a", V1 = "b")), class = "label_names_dupli")
  expect_error(plot_dag(dag1, label_shift = list(c(1,2),c(0,1))), class = "input_label_shift")
  expect_error(plot_dag(dag1, label_shift = NA), class = "input_label_shift")
  expect_error(plot_dag(dag1, label_shift = list(V1 = c(1,1), V2 = 2)), class = "input_label_shift_elements")
  expect_error(plot_dag(dag1, label_shift = list(V1 = c(1,1), V4 = c(1,1))), class = "label_shift_names")
  expect_error(plot_dag(dag1, label_shift = list(V1 = c(1,1), V1 = c(1,1))), class = "label_shift_names_dupli")
  expect_no_error(plot_dag(dag1, label_shift = list(V1 = c(1,1), outcome = c(1,1), exposure = c(1,1), adjusted = c(1,1), latent = c(1,1),
                                                    other = c(1,1), all = c(1,1))))
  expect_error(plot_dag(dag1, label_size = NA), class = "input_label_size")
  expect_error(plot_dag(dag1, label_size = NULL), class = "input_label_size")
  expect_error(plot_dag(dag1, label_size = ""), class = "input_label_size")
  expect_error(plot_dag(dag1, label_size = c(1,2)), class = "input_label_size")
  expect_no_error(plot_dag(dag1, label_size = 1.2))
  expect_no_error(plot_dag(dag1, label_size = 12L))
})

test_that("plot_dag plot and scc parameters work", {
  dag1 <- dagitty::dagitty('dag {V1 -> V2 ; V2 -> V3}')
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_error(plot_dag(dag1, node_size = NA), class = "input_node_size")
  expect_error(plot_dag(dag1, node_size = NULL), class = "input_node_size")
  expect_error(plot_dag(dag1, node_size = ""), class = "input_node_size")
  expect_error(plot_dag(dag1, node_size = c(1,2)), class = "input_node_size")
  expect_no_error(plot_dag(dag1, node_size = 1.2))
  expect_no_error(plot_dag(dag1, node_size = 12L))

  expect_error(plot_dag(dag1, node_stroke = NA), class = "input_node_stroke")
  expect_error(plot_dag(dag1, node_stroke = NULL), class = "input_node_stroke")
  expect_error(plot_dag(dag1, node_stroke = ""), class = "input_node_stroke")
  expect_error(plot_dag(dag1, node_stroke = c(1,2)), class = "input_node_stroke")
  expect_no_error(plot_dag(dag1, node_stroke = 1.2))
  expect_no_error(plot_dag(dag1, node_stroke = 12L))

  expect_error(plot_dag(dag1, e_w = NA), class = "input_e_w")
  expect_error(plot_dag(dag1, e_w = NULL), class = "input_e_w")
  expect_error(plot_dag(dag1, e_w = ""), class = "input_e_w")
  expect_error(plot_dag(dag1, e_w = c(1,2)), class = "input_e_w")
  expect_no_error(plot_dag(dag1, e_w = 1.2))
  expect_no_error(plot_dag(dag1, e_w = 12L))

  expect_error(plot_dag(dag1, cap_mm = NA), class = "input_cap_mm")
  expect_error(plot_dag(dag1, cap_mm = NULL), class = "input_cap_mm")
  expect_error(plot_dag(dag1, cap_mm = ""), class = "input_cap_mm")
  expect_error(plot_dag(dag1, cap_mm = c(1,2)), class = "input_cap_mm")
  expect_no_error(plot_dag(dag1, cap_mm = 1.2))
  expect_no_error(plot_dag(dag1, cap_mm = 12L))

  expect_error(plot_dag(dag1, scc = NA), class = "input_scc")
  expect_error(plot_dag(dag1, scc = NULL), class = "input_scc")
  expect_error(plot_dag(dag1, scc = ""), class = "input_scc")
  expect_error(plot_dag(dag1, scc = c(TRUE,FALSE)), class = "input_scc")
  expect_no_error(plot_dag(dag1, scc = T))
  expect_no_error(plot_dag(dag1, scc = FALSE))

  expect_error(plot_dag(dag1, scc_size = c(1,NA)), class = "input_scc_size")
  expect_error(plot_dag(dag1, scc_size = NULL), class = "input_scc_size")
  expect_error(plot_dag(dag1, scc_size = c("2","1")), class = "input_scc_size")
  expect_error(plot_dag(dag1, scc_size = 1), class = "input_scc_size")
  expect_error(plot_dag(dag1, scc_size = c(1,2,3)), class = "input_scc_size")
  expect_no_error(plot_dag(dag1, scc_size = c(1.2,12L)))

  expect_error(plot_dag(dag1, scc_shift = c(1,NA)), class = "input_scc_shift")
  expect_error(plot_dag(dag1, scc_shift = NULL), class = "input_scc_shift")
  expect_error(plot_dag(dag1, scc_shift = c("2","1")), class = "input_scc_shift")
  expect_error(plot_dag(dag1, scc_shift = 1), class = "input_scc_shift")
  expect_error(plot_dag(dag1, scc_shift = c(1,2,3)), class = "input_scc_shift")
  expect_no_error(plot_dag(dag1, scc_shift = c(1.2,12L)))

  expect_error(plot_dag(dag1, scc_angle = NA), class = "input_scc_angle")
  expect_error(plot_dag(dag1, scc_angle = NULL), class = "input_scc_angle")
  expect_error(plot_dag(dag1, scc_angle = ""), class = "input_scc_angle")
  expect_error(plot_dag(dag1, scc_angle = c(1,2)), class = "input_scc_angle")
  expect_no_error(plot_dag(dag1, scc_angle = 1.2))
  expect_no_error(plot_dag(dag1, scc_angle = 12L))
})

test_that("plot_dag allows NULL inputs for the correct set of parameters", {
  dag1 <- dagitty::dagitty('dag {V1 -> V2 ; V2 -> V3}')
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(plot_dag(dag1, node_outc = NULL))
  expect_no_error(plot_dag(dag1, node_expo = NULL))
  expect_no_error(plot_dag(dag1, node_adj = NULL))
  expect_no_error(plot_dag(dag1, node_latent = NULL))
  expect_no_error(plot_dag(dag1, path_causal = NULL))
  expect_no_error(plot_dag(dag1, path_biased = NULL))
  expect_no_error(plot_dag(dag1, label = NULL))
  expect_no_error(plot_dag(dag1, label_shift = NULL))
})

test_that("plot_dag calls that are expect to work do actually work", {
  dag_x <- dagitty::dagitty('dag {bb="0,0,1,1"
    C1 [pos="0.312,0.129"]
    C2 [pos="0.313,0.399"]
    O [outcome,pos="0.394,0.254"]
    V1 [pos="0.223,0.256"]
    C1 -> O ; C1 -> V1 ; C2 -> O ; C2 -> V1 ; V1 -> O}')
  testthat::skip_if_not_installed(c("ggdag", "ggforce", "ggraph"))
  expect_no_error(plot_dag(dag_x, node_expo = "V1", node_adj = c("C1","C2"), path_causal = "V1 -> O",
                           label = c(V1 = "Expo"), label_shift = list(outcome = c(0.01,0), exposure = c(0,0.015)),
                           cap_mm = 10, e_w = 1, node_stroke = 2, label_size = 3, node_size = 8))
  expect_no_error(plot_dag(dag_x, node_expo = "V1", label_shift = list(all = c(0,0.04)), node_latent = "C2", path_biased = c("C2->V1","C2->O"),
                           e_w = 1, scc = T, scc_size = c(0.11,0.035), scc_shift = c(-0.003,-0.055), scc_angle = 5))
})