tests/testthat/test-class_glimpse.R

In targets: Dynamic Function-Oriented 'Make'-Like Declarative Pipelines

tar_test("glimpse$targets_only", {
  skip_if_not_installed("visNetwork")
  net <- glimpse_init(pipeline_init(), targets_only = FALSE)
  expect_equal(net$targets_only, FALSE)
  net <- glimpse_init(pipeline_init(), targets_only = TRUE)
  expect_equal(net$targets_only, TRUE)
})

tar_test("glimpse$allow", {
  skip_if_not_installed("visNetwork")
  net <- glimpse_init(pipeline_init(), allow = "x")
  expect_equal(net$allow, "x")
})

tar_test("glimpse$exclude", {
  skip_if_not_installed("visNetwork")
  net <- glimpse_init(pipeline_init(), exclude = "x")
  expect_equal(net$exclude, "x")
})

tar_test("glimpse$pipeline", {
  expect_equal(
    class(glimpse_init(pipeline_init())$pipeline)[1],
    "tar_pipeline"
  )
})

tar_test("vertices and edges", {
  envir <- new.env(parent = baseenv())
  evalq({
    f <- function(x) g(x) + h
    g <- function(x) i
    h <- 1
    i <- 1
  }, envir = envir)
  tar_option_set(envir = envir)
  pipeline <- pipeline_init(
    list(
      target_init("x", quote(f(1))),
      target_init("y", quote(g(2))),
      target_init("z", quote(x + y))
    )
  )
  vis <- glimpse_init(pipeline, targets_only = FALSE)
  vis$update()
  vertices <- vis$vertices
  vertices <- vertices[order(vertices$name), ]
  exp_imports <- data_frame(
    name = c("g", "f", "h", "i"),
    type = c("function", "function", "object", "object"),
    status = rep("none", 4L),
    seconds = NA_real_,
    bytes = NA_real_,
    branches = NA_real_
  )
  exp_targets <- data_frame(
    name = c("x", "y", "z"),
    type = rep("stem", 3L),
    status = rep("none", 3L),
    seconds = NA_real_,
    bytes = NA_real_,
    branches = NA_real_
  )
  exp <- rbind(exp_imports, exp_targets)
  exp <- exp[order(exp$name), ]
  rownames(vertices) <- NULL
  rownames(exp) <- NULL
  expect_equal(vertices, exp)
  edges <- vis$edges
  edges <- edges[order(edges$from), ]
  exp_imports <- data_frame(from = c("g", "h", "i"), to = c("f", "f", "g"))
  exp_targets <- data_frame(
    from = c("f", "g", "x", "y"),
    to = c("x", "y", "z", "z")
  )
  exp <- rbind(exp_imports, exp_targets)
  exp <- exp[order(exp$from), ]
  rownames(edges) <- NULL
  rownames(exp) <- NULL
  expect_equal(edges, exp)
})

tar_test("glimpse$update() with allow", {
  skip_if_not_installed("visNetwork")
  x <- target_init("x", quote(1))
  y <- target_init("y", quote(x))
  pipeline <- pipeline_init(list(x, y))
  net <- glimpse_init(pipeline, allow = "x")
  net$update()
  vertices <- net$vertices
  exp <- data_frame(
    name = "x",
    type = "stem",
    status = "none",
    seconds = NA_real_,
    bytes = NA_real_,
    branches = NA_integer_
  )
  rownames(vertices) <- NULL
  rownames(exp) <- NULL
  expect_equal(vertices[, colnames(exp)], exp)
  edges <- net$edges
  exp <- data_frame(from = character(0), to = character(0))
  expect_equal(edges, exp)
})

tar_test("glimpse$update() with exclude", {
  skip_if_not_installed("visNetwork")
  x <- target_init("x", quote(1))
  y <- target_init("y", quote(x))
  pipeline <- pipeline_init(list(x, y))
  net <- glimpse_init(pipeline, exclude = "x")
  net$update()
  vertices <- net$vertices
  exp <- data_frame(
    name = "y",
    type = "stem",
    status = "none"
  )
  rownames(vertices) <- NULL
  rownames(exp) <- NULL
  expect_equal(vertices[, colnames(exp)], exp)
  edges <- net$edges
  exp <- data_frame(from = character(0), to = character(0))
  expect_equal(edges, exp)
})

tar_test("glimpse$update() with names", {
  skip_if_not_installed("visNetwork")
  x <- target_init("x", quote(1))
  y <- target_init("y", quote(x))
  z <- target_init("z", quote(y))
  pipeline <- pipeline_init(list(x, y, z))
  net <- glimpse_init(pipeline, names = "y", targets_only = TRUE)
  net$update()
  expect_equal(sort(net$vertices$name), sort(c("x", "y")))
  expect_equal(net$edges$from, "x")
  expect_equal(net$edges$to, "y")
})

tar_test("glimpse$update() with names and shortcut", {
  skip_if_not_installed("visNetwork")
  x <- target_init("x", quote(1))
  y <- target_init("y", quote(x))
  z <- target_init("z", quote(y))
  pipeline <- pipeline_init(list(x, y, z))
  local_init(pipeline)$run()
  net <- glimpse_init(
    pipeline,
    names = "y",
    targets_only = TRUE,
    shortcut = TRUE
  )
  net$update()
  expect_equal(net$vertices$name, "y")
  expect_equal(nrow(net$edges), 0L)
})

tar_test("glimpse$validate()", {
  expect_silent(glimpse_init(pipeline_init())$validate())
})

tar_test("glimpse$validate() with names, allow, and exclude", {
  x <- glimpse_init(
    pipeline_init(),
    names = "x",
    allow = "x",
    exclude = "y"
  )
  expect_silent(x$validate())
})