tests/testthat/test-errors.R

In dosearch: Causal Effect Identification from Multiple Incomplete Data Sources

test_that("missing required arguments fails", {
  expect_error(
    dosearch(),
    "Argument `data` is missing."
  )
  expect_error(
    dosearch("p(x)"),
    "Argument `query` is missing."
  )
  expect_error(
    dosearch("p(x)", "p(y)"),
    "Argument `graph` is missing."
  )
})

test_that("invalid input types fail", {
  expect_error(
    dosearch(y ~ x),
    "Argument `data` is of an unsupported type\\."
  )
  expect_error(
    dosearch(c("a", "b")),
    "Argument `data` must be of length 1 when of type `character`\\."
  )
  expect_error(
    dosearch("p(x)", y ~ x),
    "Argument `query` is of an unsupported type\\."
  )
  expect_error(
    dosearch("p(x)", c("a", "b")),
    "Argument `query` must be of length 1 when of type `character`\\."
  )
  expect_error(
    dosearch("p(x)", "p(y)", y ~ x),
    "Argument `graph` is of an unsupported type\\."
  )
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y", control = 0L),
    "Argument `control` must be a list."
  )
  specs <- c("transportability", "selection_bias", "missing_data")
  args_init <- list(data = "p(x)", query = "p(y)", graph = "x -> y")
  for (spec in specs) {
    args <- args_init
    args[[spec]] <- list()
    expect_error(
      do.call("dosearch", args = args),
      paste0("Argument `", spec, "` must be a character vector of length 1\\.")
    )
  }
})

test_that("malformed alternative distribution format input fails", {
  query <- "p(y|do(x))"
  graph <- "x -> y"
  expect_error(
    dosearch(c(x = NA_real_), query, graph),
    paste0(
      "Invalid distribution format c\\(x = NA_real_\\): ",
      "all role values must be non-missing and finite"
    )
  )
  expect_error(
    dosearch(c(x = -1), query, graph),
    paste0(
      "Invalid variable roles in distribution format c\\(x = -1\\): ",
      "all role values must be either 0, 1 or 2"
    )
  )
  expect_error(
    dosearch(c(x = 1, y = 1), query, graph),
    paste0(
      "Invalid variable roles in distribution format c\\(x = 1, y = 1\\): ",
      "at least one variable must have role value 0"
    )
  )
  expect_error(
    dosearch(c(0, 0), query, graph),
    paste0(
      "Invalid distribution format c\\(0, 0\\): ",
      "role values must be given as a named vector"
    )
  )
  expect_error(
    dosearch(list(list()), query, graph),
    "Unable to parse distribution format list()"
  )
})

test_that("control arguments of wrong length fail", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y", control = list(formula = c(TRUE, TRUE))),
    paste0(
      "All elements of argument `control` ",
      "must be of length 1 \\(except `rules` and `con_vars`\\)\\.\n",
      "The following elements have length > 1: formula"
    )
  )
})

test_that("unknown control arguments fail", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y", control = list(wrong_arg = 1)),
    "Unknown control arguments: wrong_arg"
  )
})

test_that("wrong control argument types fail", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y", control = list(formula = -1)),
    paste0(
      "Some elements of argument `control` have an invalid type\\.\n",
      "Invalid arguments: formula\n",
      "Provided types: double\n",
      "Expected types: logical"
    )
  )
})

test_that("gets can't be got for non-dosearch objects", {
  err <- "Argument `x` must be an object of class `dosearch`"
  expect_error(is_identifiable(data.frame()), err)
  expect_error(get_formula(data.frame()), err)
  expect_error(get_derivation(data.frame()), err)
  expect_error(get_benchmark(data.frame()), err)
})

test_that("print and summary fail for non-dosearch objects", {
  err <- "Argument `.+` must be an object of class `(.*?)dosearch`"
  expect_error(print.dosearch(data.frame()), err)
  expect_error(summary.dosearch(data.frame()), err)
  expect_error(print.summary.dosearch(data.frame()), err)
})

test_that("transportability and selection bias nodes exist", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y", transportability = "t"),
    "Transportability nodes t are not present in the graph"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y", selection_bias = "s"),
    "Selection bias nodes s are not present in the graph"
  )
})

test_that("empty graph fails", {
  expect_error(
    dosearch("p(x)", "p(y)", ""),
    "Invalid graph, the graph is empty\\."
  )
})

test_that("multiple graphs fail", {
  expect_error(
    dosearch("p(x)", "p(y)", c("x -> y", "z -> x")),
    "Argument `graph` must be of length 1 when of `character` type"
  )
})

test_that("too large a graph fails", {
  data <- "p(x)"
  query <- "p(y)"
  graph <- paste0(
    apply(
      cbind(letters[seq_len(16L)], " -> ", letters[1L + seq_len(16L)]),
      1L,
      paste0,
      collapse = ""
    ),
    collapse = "\n"
  )
  expect_error(
    dosearch(data, query, graph),
    "The inputs imply a graph with more than 30 nodes"
  )
})

test_that("malformed graph lines fail", {
  graph <- "
    x - > y
    x z w y
    x y
  "
  expect_error(
    dosearch("p(x)", "p(y)", graph),
    "Invalid graph, malformed lines found"
  )
  graph <- "
    x z w y :: z = 1
  "
  expect_error(
    dosearch("p(x)", "p(y)", graph),
    "Invalid graph, malformed lines found"
  )
})

test_that("unknown edge type fails", {
  expect_error(
    dosearch("p(x)", "p(y)", "x edge y"),
    "Invalid graph, unknown edge types found: edge"
  )
})

test_that("self loops fail", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> x"),
    "the graph contains self-loops"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "x -> x : y = 1"),
    "the graph contains self-loops"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "x <-> x"),
    "the graph contains self-loops"
  )
})

test_that("cyclic graph fails", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> z\nz -> y\ny -> x"),
    "the graph contains cycles"
  )
})

test_that("bidirected edge in an LDAG fails", {
  expect_error(
    dosearch("p(x)", "p(y)", "x <-> y : y = 1"),
    "bidirected edges are not supported for LDAGs"
  )
})

test_that("invalid edge labels fail", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y : x = 1"),
    "x cannot appear in the label"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y : y = 1"),
    "y cannot appear in the label"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y : z = 1, z = 0 \n z -> y"),
    "duplicate assignment"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y : z = 0"),
    "only other parents of y may be assigned"
  )
})

test_that("malformed missing data mechanisms fail", {
  expect_error(
    dosearch("p(x)", "p(y)", "x -> y", missing_data = ""),
    "Malformed missing data mechanisms"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "r_x -> y", missing_data = "r_x : x, r_y : y"),
    "A missing data mechanism cannot be a parent of a true variable"
  )
})

test_that("syntactically incorrect data inputs fail", {
  malformed_inputs <- c(NA, "(", "p(", "p(x", "p(x|y", "p(x|do(x", "p(x|do(x)")
  for (m in malformed_inputs) {
    expect_error(
      dosearch(m, "p(y)", "x -> y"),
      "Unable to parse input distribution"
    )
  }
  for (m in malformed_inputs) {
    expect_error(
      dosearch(m, "p(y)", "x -> y : z = 1 \n z -> y"),
      "Unable to parse input distribution"
    )
  }
})

test_that("syntactically correct but semantically incorrect inputs fail", {
  md <- "r_x : x, r_y : y"
  expect_error(
    dosearch("p(x,x)", "p(y)", "x -> y"),
    "duplicated variables"
  )
  expect_error(
    dosearch("p(x,x)", "p(y)", "x -> y : z = 0 \n z -> y"),
    "duplicated variables"
  )
  expect_error(
    dosearch("p(x = 2)", "p(y)", "x -> y : z = 0 \n z -> y"),
    "Invalid value assignment"
  )
  expect_error(
    dosearch("p(x,r_x=2,r_y=1)", "p(y)", "x -> r_x", missing_data = md),
    "multiple symbols used for missing data mechanisms"
  )
  expect_error(
    dosearch("p(x,r_x=2)", "p(y)", "x -> r_x", missing_data = md),
    "invalid symbol used for a missing data mechanism"
  )
  expect_error(
    dosearch("p(x,x*)", "p(y)", "x -> r_x", missing_data = md),
    "true and proxy versions of the same variable on the left-hand side"
  )
  expect_error(
    dosearch("p(y|x,x*)", "p(y)", "x -> r_x", missing_data = md),
    "true and proxy versions of the same variable on the right-hand side"
  )
  expect_error(
    dosearch("p(x|x*)", "p(y)", "x -> r_x", missing_data = md),
    "true variable of a proxy variable on the left-hand side"
  )
  expect_error(
    dosearch("p(x*|x)", "p(y)", "x -> r_x", missing_data = md),
    "proxy variable of a true variable on the left-hand side"
  )
  expect_error(
    dosearch("p(x = 1)", "p(y)", "x -> r_x", missing_data = md),
    "value assignment of a non-missing data mechanism"
  )
  expect_error(
    dosearch("p(x|x)", "p(y)", "x -> y"),
    "same variable on the left and right-hand side"
  )
  expect_error(
    dosearch("p(x|x)", "p(y)", "x -> y : z = 0 \n z -> y"),
    "same variable on the left and right-hand side"
  )
  expect_error(
    dosearch("p(x|do(x))", "p(y)", "x -> y"),
    "same variable on the left and right-hand side"
  )
  expect_error(
    dosearch("p(t)", "p(y)", "t -> y", transportability = "t"),
    "transportability node on the left-hand side"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "y -> t", transportability = "t"),
    "a transportability node cannot be a child of another node"
  )
  expect_error(
    dosearch("p(y|do(t))", "p(y)", "t -> y", transportability = "t"),
    "intervention on a transportability node"
  )
  expect_error(
    dosearch("p(s)", "p(y)", "y -> s", selection_bias = "s"),
    "selection bias node on the left-hand side"
  )
  expect_error(
    dosearch("p(x)", "p(y)", "s -> y", selection_bias = "s"),
    "selection bias node cannot be a parent of another node"
  )
  expect_error(
    dosearch("p(y|do(s))", "p(y)", "y -> s", selection_bias = "s"),
    "intervention on a selection bias node"
  )
})

test_that("igraph input fails when the package is not available", {
  skip_if_not_installed("mockr")
  skip_if_not_installed("igraph")
  g_igraph <- igraph::graph.formula(
    x -+ z, z -+ y, x -+ y, y -+ x,
    simplify = FALSE
  )
  g_igraph <- igraph::set_edge_attr(g_igraph, "description", 3:4, "U")
  mockr::with_mock(
    require_namespace = function(...) FALSE,
    {
      expect_error(
        dosearch("p(x)", "p(y)", g_igraph),
        "The `igraph` package is not available"
      )
    }
  )
})

test_that("dagitty input fails when the package is not available", {
  skip_if_not_installed("mockr")
  skip_if_not_installed("dagitty")
  g_dagitty <- dagitty::dagitty("dag{x -> z -> y; x <-> y}")
  mockr::with_mock(
    require_namespace = function(...) FALSE,
    {
      expect_error(
        dosearch("p(x)", "p(y)", g_dagitty),
        "The `dagitty` package is not available"
      )
    }
  )
})

test_that("non-DAG dagitty input fails", {
  skip_if_not_installed("dagitty")
  g_dagitty <- dagitty::dagitty("mag{x -> z -> y; x <-> y}")
  expect_error(
    dosearch("p(x)", "p(y)", g_dagitty),
    "Attempting to use `dagitty`, but the graph type is not `dag`"
  )
})