Nothing
context("Graph")
test_that("linear graph", {
skip_if_not_installed("rpart")
g = Graph$new()
expect_equal(g$ids(sorted = TRUE), character(0))
# FIXME: we should "dummy" ops, so we can change properties of the ops at will
# we should NOT use PipeOpNOP, because we want to check that $train/$predict actually does something.
# FIXME: we should packages of the graph
op_ds = PipeOpSubsample$new()
op_pca = PipeOpPCA$new()
op_lrn = PipeOpLearner$new(mlr_learners$get("classif.rpart"))
g$add_pipeop(op_ds)
g$add_pipeop(op_pca)
expect_graph(g)
g$add_edge("subsample", "pca")
expect_graph(g)
expect_output(print(g), "Graph with 2 PipeOps.*subsample.*UNTRAINED.*pca.*UNTRAINED")
inputs = mlr_tasks$get("iris")
x = g$train(inputs)
expect_task(x[[1]])
expect_output(print(g), "Graph with 2 PipeOps.*subsample.*list.*pca.*prcomp")
out = g$predict(inputs)
expect_task(x[[1]])
g$add_pipeop(op_lrn)
expect_graph(g)
g$add_edge("subsample", "classif.rpart")
expect_error(g$add_edge("pca", "classif.rpart"),
"Channel.*output.*of node.*subsample.*already connected to channel.*input.*of node classif.rpart")
expect_error(g$add_pipeop(op_lrn), "PipeOp with id.*rpart.*already in Graph")
expect_deep_clone(g, g$clone(deep = TRUE))
})
test_that("complex graph", {
# test that debug pipeops exist
expect_pipeop(PipeOpDebugBasic$new())
expect_pipeop(PipeOpDebugMulti$new(1, 1))
expect_pipeop(PipeOpDebugMulti$new(3, 2))
expect_graph(PipeOpDebugBasic$new() %>>% PipeOpDebugMulti$new(1, 2) %>>% PipeOpDebugMulti$new(2, 1, "debug2"))
expect_graph(PipeOpDebugBasic$new() %>>% PipeOpDebugMulti$new(1, 2) %>>%
pipeline_greplicate(PipeOpDebugMulti$new(1, 2, "debug2"), 2))
biggraph = PipeOpDebugBasic$new() %>>%
PipeOpDebugMulti$new(1, 2) %>>%
pipeline_greplicate(PipeOpDebugMulti$new(1, 2, "debug2"), 2) %>>%
gunion(list(PipeOpDebugBasic$new("basictop"),
PipeOpDebugMulti$new(2, 1, "debug2"),
PipeOpDebugBasic$new("basicbottom"))) %>>%
PipeOpDebugMulti$new(3, 1, "debug3")
lines = strsplit(capture_output(biggraph$train(1)), "\n")[[1]]
expect_set_equal(lines,
c("Training debug.basic",
"Training debug.multi with input list(input_1 = 1)",
"Training debug2_1 with input list(input_1 = 2)",
"Training debug2_2 with input list(input_1 = 3)",
"Training basictop",
"Training basicbottom",
"Training debug2 with input list(input_1 = 4, input_2 = 4)",
"Training debug3 with input list(input_1 = 3, input_2 = 5, input_3 = 5)"),
info = paste0("'", lines, "'", collapse = "', '"))
skip_if_not_installed("igraph")
pdf(file = NULL) # don't show plot. It is annoying.
biggraph$plot()
dev.off()
p = biggraph$plot(TRUE)
expect_class(p, "htmlwidget")
expect_class(p, "visNetwork")
})
test_that("input / output lists and naming", {
gr = Graph$new()$add_pipeop(PipeOpDebugMulti$new(2, 2))
expect_equal(csvify(gr$input),
c("debug.multi.input_1,*,*,debug.multi,input_1",
"debug.multi.input_2,*,*,debug.multi,input_2"))
expect_equal(csvify(gr$output),
c("debug.multi.output_1,*,*,debug.multi,output_1",
"debug.multi.output_2,*,*,debug.multi,output_2"))
expect_output(gr$train(9), "list\\(input_1 = 9, input_2 = 9\\)")
expect_output(gr$train(-9), "list\\(input_1 = -9, input_2 = -9\\)")
expect_output(gr$train(list(1, 2), single_input = FALSE),
"list\\(input_1 = 1, input_2 = 2\\)")
expect_output(gr$train(list(debug.multi.input_1 = 1, debug.multi.input_2 = 2), single_input = FALSE),
"list\\(input_1 = 1, input_2 = 2\\)")
expect_output(gr$train(list(debug.multi.input_2 = 2, debug.multi.input_1 = 1), single_input = FALSE),
"list\\(input_1 = 1, input_2 = 2\\)")
if (packageVersion("checkmate") >= "2.1.0") {
expect_error(gr$train(list(debug.multi.input_2 = 2, debug.multi.input_99 = 1), single_input = FALSE),
"debug.multi.input_1")
}
expect_error(gr$train(list(), single_input = FALSE), "have length 2")
expect_error(gr$train(list(1, 2, 3), single_input = FALSE), "have length 2")
expect_equal(gr$train(1), list(debug.multi.output_1 = 2, debug.multi.output_2 = 3))
gr$add_pipeop(PipeOpDebugMulti$new(2, 3, "debug2"))
gr$add_pipeop(PipeOpDebugMulti$new(3, 2, "debug3"))
gr$add_edge("debug.multi", "debug3", 1, 2)
gr$add_edge("debug.multi", "debug3", "output_2", "input_1")
gr$add_edge("debug2", "debug.multi", 2, 1)
gr$add_edge("debug2", "debug.multi", "output_1", "input_2")
# layout now:
#
# | 1\ 2/
# | <debug2>
# | 1/ 2| 3\
# | / | \
# | 2| 1| \
# | <multi> |
# | 1| 2| |
# \ | / |
# 3\ 2| 1/ |
# <debug3> |
# 1/ 2\ |
#
# input should be debug2.1, debug2.2, debug3.3
# output should be debug2.3, debug3.1, debug3.2
# (inputs and outputs in PipeOp order first, in channel order second)
skip_if_not_installed("igraph")
pdf(file = NULL) # don't show plot. It is annoying.
gr$plot()
dev.off()
p = gr$plot(TRUE)
expect_class(p, "htmlwidget")
expect_class(p, "visNetwork")
# test output 1: debug.multi was already trained above
expect_output(print(gr),
"debug2.*<<UNTRAINED>>.*debug.multi.*\n.*debug.multi.*<list>.*debug3.*debug2.*\n.*debug3.*<<UNTRAINED>>.*debug.multi")
gr$pipeops$debug.multi$state = NULL
expect_output(print(gr),
"debug2.*<<UNTRAINED>>.*debug.multi.*\n.*debug.multi.*<<UNTRAINED>>.*debug3.*debug2.*\n.*debug3.*<<UNTRAINED>>.*debug.multi")
expect_equal(csvify(gr$input),
c("debug2.input_1,*,*,debug2,input_1",
"debug2.input_2,*,*,debug2,input_2",
"debug3.input_3,*,*,debug3,input_3"))
expect_equal(csvify(gr$output),
c("debug2.output_3,*,*,debug2,output_3",
"debug3.output_1,*,*,debug3,output_1",
"debug3.output_2,*,*,debug3,output_2"))
lines = strsplit(capture_output({
trained = gr$train(list(debug2.input_2 = 10, debug3.input_3 = 100, debug2.input_1 = 1000), single_input = FALSE)
}),
"\n")[[1]]
expect_equal(lines,
c("Training debug2 with input list(input_1 = 1000, input_2 = 10)",
"Training debug.multi with input list(input_1 = 1002, input_2 = 1001)",
"Training debug3 with input list(input_1 = 1004, input_2 = 1003, input_3 = 100)"))
expect_equal(trained, list(debug2.output_3 = 1003, debug3.output_1 = 1005, debug3.output_2 = 1006))
# test output II
expect_output(print(gr),
"debug2.*<list>.*debug.multi.*\n.*debug.multi.*<list>.*debug3.*debug2.*\n.*debug3.*<list>.*debug.multi")
})
test_that("edges that introduce loops cannot be added", {
g = Graph$new()$
add_pipeop(PipeOpNOP$new("p1"))$
add_pipeop(PipeOpNOP$new("p2"))
gclone = g$clone(deep = TRUE)
expect_deep_clone(g, gclone)
expect_error(g$add_edge("p1", "p1", 1, 1), "Cycle detected")
expect_deep_clone(g, gclone) # check that edges did not change
g$add_edge("p1", "p2")
gclone = g$clone(deep = TRUE)
expect_deep_clone(g, gclone)
expect_error(g$add_edge("p2", "p1", 1, 1), "Cycle detected")
expect_deep_clone(g, gclone) # check that edges did not change
})
test_that("assert_graph test", {
gr = PipeOpNOP$new() %>>% PipeOpDebugMulti$new(1, 1)
gr2 = assert_graph(gr)
expect_error(expect_deep_clone(gr, gr2), class = "error", regexp = "addresses differ.*isn't true|addresses differ.*is not TRUE")
gr2 = as_graph(gr, clone = TRUE)
expect_deep_clone(gr, gr2)
expect_error(assert_graph(PipeOpNOP$new()), "inherit from class.*Graph")
assert_graph(as_graph(PipeOpNOP$new()))
po = PipeOpNOP$new()
expect_error(expect_deep_clone(po, po), class = "error", regexp = "addresses differ.*isn't true|addresses differ.*is not TRUE")
po2 = as_graph(po, clone = TRUE)$pipeops[[1]]
expect_deep_clone(po, po2)
})
test_that("Empty Graph", {
expect_equal(length(Graph$new()$pipeops), 0)
expect_equal(nrow(Graph$new()$edges), 0)
expect_output(print(Graph$new()), "^Empty Graph\\.$")
skip_if_not_installed("igraph")
expect_output(Graph$new()$plot(), "^Empty Graph, not plotting\\.$")
expect_equal(gunion(list()), Graph$new())
expect_equal(gunion(list(Graph$new())), Graph$new())
expect_equal(gunion(list(Graph$new(), Graph$new())), Graph$new())
expect_equal(pipeline_greplicate(Graph$new(), 100), Graph$new())
expect_error(Graph$new()$add_edge("a", "b"), "Cannot add edge to empty Graph")
expect_equal(Graph$new()$state, list())
expect_equal(Graph$new()$update_ids()$ids(), character(0))
expect_null(chain_graphs(list(), in_place = FALSE))
expect_null(chain_graphs(list(), in_place = FALSE))
expect_null(chain_graphs(list(NULL), in_place = FALSE))
expect_null(chain_graphs(list(NULL), in_place = TRUE))
})
test_that("Graph printer aux function calculates col widths well", {
skip_on_cran()
set.seed(8008135)
effective_outwidth = function(colwidths, collimit) {
colwidths[colwidths > collimit] = collimit + 3 # this is how data.table does it
sum(colwidths + 1) + 4 # add 1 spacer between columns, and an extra margin of 4
}
test_outlimit = function(colwidths, outwidth) {
collimit = calculate_collimit(colwidths, outwidth)
if (effective_outwidth(colwidths, collimit) > outwidth) {
# expectations are *really* slow, so only do them if they fail in this high volume test
expect_lte(effective_outwidth(colwidths, collimit), outwidth)
}
}
test_all_outlimits = function(colwidths) {
for (outwidth in seq(max(length(colwidths), length(colwidths) * min(colwidths) - 2),
length(colwidths) * max(colwidths) + 2)) {
test_outlimit(colwidths, outwidth)
}
}
for (numcols in 1:10) {
replicate(1000, test_all_outlimits(rgeom(numcols, 0.1)))
}
expect_string("spurious expectation to show that we didn't skip this test")
})
test_that("Intermediate results are saved to Graph if requested", {
g = PipeOpPCA$new() %>>% PipeOpCopy$new(2) %>>%
gunion(list(PipeOpScale$new(), PipeOpNOP$new()))
task = mlr_tasks$get("iris")
res = g$train(task)
expect_null(g$pipeops$pca$.result)
g$keep_results = TRUE
res = g$predict(task)
restask = PipeOpPCA$new()$train(list(task))
expect_equal(g$pipeops$pca$.result, restask)
restask2 = PipeOpScale$new()$train(restask)
expect_equal(g$pipeops$scale$.result, restask2)
expect_equal(g$pipeops$nop$.result, restask)
})
test_that("Namespaces get loaded", {
g = PipeOpPCA$new() %>>% PipeOpCopy$new(2) %>>%
gunion(list(PipeOpScale$new(), PipeOpNOP$new()))
g$train(mlr_tasks$get("iris"))
g$pipeops$scale$packages = c("4rfjfw", "324r32")
g$pipeops$nop$packages = c("4rfjfw", "9422228u")
res = try(g$train(mlr_tasks$get("iris")), silent = TRUE)
expect_class(res, "try-error")
expect_subset(c(
" Error loading package 9422228u (required by nop):",
" Error loading package 4rfjfw (required by scale, nop):",
" Error loading package 324r32 (required by scale):"),
strsplit(res, "\n")[[1]])
})
test_that("Graph State", {
g = PipeOpPCA$new() %>>% PipeOpCopy$new(2) %>>%
gunion(list(PipeOpScale$new(), PipeOpNOP$new()))
g_clone = g$clone(deep = TRUE)
task = mlr_tasks$get("iris")
res = g$train(task)
g_clone$state = g$state
expect_deep_clone(g_clone, g$clone(deep = TRUE))
expect_equal(g$predict(task), g_clone$predict(task))
})
test_that("Graph with vararg input", {
t1 = tsk("iris")
t2 = PipeOpPCA$new()$train(list(t1))[[1]]
tcombined = PipeOpFeatureUnion$new()$train(list(t1, t2))[[1]]
gr = as_graph(PipeOpFeatureUnion$new())
expect_equal(tcombined, gr$train(list(t1, t2), single_input = FALSE)[[1]])
expect_equal(tcombined, gr$predict(list(t1, t2), single_input = FALSE)[[1]])
gr = gunion(list(PipeOpNOP$new(), gr, PipeOpNOP$new(id = "nop2"), PipeOpNOP$new(id = "nop3")))
expect_equal(list(nop.output = 1, featureunion.output = tcombined, nop2.output = 2, nop3.output = 3),
gr$train(list(1, t1, t2, 2, 3), single_input = FALSE))
})
test_that("single pipeop plot", {
skip_if_not_installed("igraph")
imp_num = po("imputehist")
graph = as_graph(imp_num)
pdf(file = NULL)
graph$plot()
dev.off()
p = graph$plot(TRUE)
expect_class(p, "htmlwidget")
expect_class(p, "visNetwork")
})
test_that("dot output", {
gr = Graph$new()$add_pipeop(PipeOpDebugMulti$new(2, 2))
gr$add_pipeop(PipeOpDebugMulti$new(2, 3, "debug2"))
gr$add_pipeop(PipeOpDebugMulti$new(3, 2, "debug3"))
gr$add_edge("debug.multi", "debug3", 1, 2)
gr$add_edge("debug.multi", "debug3", "output_2", "input_1")
gr$add_edge("debug2", "debug.multi", 2, 1)
gr$add_edge("debug2", "debug.multi", "output_1", "input_2")
out = capture.output(gr$print(dot = TRUE, dotname = "test", fontsize = 20))
expect_true(out[1L] == "digraph test {")
expect_true(out[22L] == "}")
expect_setequal(c("1 -> 4;", "1 -> 4;", "2 -> 1;", "2 -> 1;", "3 -> 2;", "3 -> 2;",
"3 -> 4;", "2 -> 5;", "4 -> 6;", "4 -> 7;",
"1 [label=\"debug_multi\",fontsize=20];",
"2 [label=\"debug2\",fontsize=20];",
"3 [label=\"INPUT\",fontsize=20];",
"4 [label=\"debug3\",fontsize=20];",
"5 [label=\"OUTPUT",
"debug2_output_3\",fontsize=20];",
"6 [label=\"OUTPUT",
"debug3_output_1\",fontsize=20];",
"7 [label=\"OUTPUT",
"debug3_output_2\",fontsize=20]"), out[-c(1L, 22L)])
gr = Graph$new()
out = capture.output(print(gr, dot = TRUE))
expect_setequal(c("digraph dot {", "", "}"), out)
gr = Graph$new()$add_pipeop(po("scale"))
out = capture.output(gr$print(dot = TRUE))
expect_setequal(c("digraph dot {", "1 [label=\"scale\",fontsize=24]", "}"), out)
gr = po("scale") %>>% po("pca")
gr$add_pipeop(po("nop"))
out = capture.output(gr$print(dot = TRUE))
expect_true(out[1L] == "digraph dot {")
expect_true(out[15L] == "}")
expect_setequal(c("1 -> 3;", "2 -> 1;", "2 -> 4;", "3 -> 5;", "4 -> 6;",
"1 [label=\"scale\",fontsize=24];",
"2 [label=\"INPUT\",fontsize=24];",
"3 [label=\"pca\",fontsize=24];",
"4 [label=\"nop\",fontsize=24];",
"5 [label=\"OUTPUT",
"pca_output\",fontsize=24];",
"6 [label=\"OUTPUT",
"nop_output\",fontsize=24]"), out[-c(1L, 15L)])
})
test_that("help() call", {
if (identical(help, utils::help)) { # different behaviour if pkgload / devtools are doing help vs. vanilla R help()
# c() to drop attributes
expect_equal(
c(help("Graph", package = "mlr3pipelines")),
c((po("scale") %>>% po("nop"))$help())
)
} else {
expect_equal(
help("Graph", package = "mlr3pipelines"),
(po("scale") %>>% po("nop"))$help()
)
}
})
test_that("Same output into multiple channels does not cause a bug", {
PipeOpDebug = R6Class(
inherit = PipeOp,
public = list(
initialize = function(id = "debug", param_vals = list(), n) {
output = data.table(
name = paste0("output", seq_len(n)),
train = rep("numeric", times = n),
predict = rep("numeric", times = n)
)
input = data.table(name = "input", train = "numeric", predict = "numeric")
private$.n = n
super$initialize(
id = id,
param_set = ps(),
param_vals = param_vals,
input = input,
output = output
)
}
),
private = list(
.n = NULL,
.train = function(inputs) {
# set the "wrong" names here, since we need to rely on PipeOp's train/predict to do
# the right thing here and ignore our names.
x = set_names(inputs$input, paste0("output", rev(inputs$input)))
as.list(x)
}
)
)
po1 = PipeOpDebug$new(n = 2L, id = "po1")
po2 = PipeOpDebug$new(n = 1L, id = "po2")
po3 = PipeOpDebug$new(n = 1L, id = "po3")
po4 = PipeOpDebug$new(n = 1L, id = "po4")
graph = Graph$new()
graph$add_pipeop(po1)
graph$add_pipeop(po2)
graph$add_pipeop(po3)
graph$add_pipeop(po4)
graph$add_edge("po1", "po2", "output1", "input")
graph$add_edge("po1", "po3", "output2", "input")
graph$add_edge("po1", "po4", "output2", "input")
res = graph$train(c(1, 2))
expect_true(res$po2.output1 == 1)
expect_true(res$po3.output1 == 2)
expect_true(res$po4.output1 == 2)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.