context("Ensemble tests")
test_that("Majority votes", {
probs <- matrix(
c(1, 1, 1, 1, 0.6, 0.1, 0.8, 0.2, 0.8, 0.3, 0.4, 0.1),
ncol = 3
)
preds <- matrix(
unlist(as.numeric(probs > 0.5)),
ncol = 3
)
# probs preds
# [,1] [,2] [,3] [,1] [,2] [,3]
# [1,] 1 0.6 0.8 [1,] 1 1 1
# [2,] 1 0.1 0.3 [2,] 1 0 0
# [3,] 1 0.8 0.4 [3,] 1 1 0
# [4,] 1 0.2 0.1 [4,] 1 0 0
result <- utiml_ensemble_majority(preds, probs)
expect_equal(result$bipartition, c(1,0,1,0))
expect_equal(result$probability, c(1,1/3,2/3,1/3))
result2 <- utiml_ensemble_majority(preds, probs)
expect_equal(result, result2)
probs <- matrix(
c(0.5, 0.1,
1, 0.5,
0.6, 1),
ncol = 2
)
preds <- matrix(
unlist(as.numeric(probs >= 0.5)),
ncol = 2
)
# probs preds
# [,1] [,2] [,1] [,2]
# [1,] 0.5 0.5 [1,] 1 1
# [2,] 0.1 0.6 [2,] 0 1
# [3,] 1.0 1.0 [3,] 1 1
result <- utiml_ensemble_majority(preds, probs)
expect_equal(result$bipartition, c(1,1,1))
expect_equal(result$probability, c(1,0.5,1))
})
test_that("Other votes", {
probs <- matrix(
c(1, 1, 1, 1, 0.6, 0.1, 0.8, 0.2, 0.8, 0.3, 0.4, 0.1),
ncol = 3
)
preds <- matrix(
unlist(as.numeric(probs > 0.5)),
ncol = 3
)
result <- utiml_ensemble_maximum(preds, probs)
expect_equivalent(result$bipartition, c(1,1,1,1))
expect_equivalent(result$probability, c(1,1,1,1))
result <- utiml_ensemble_minimum(preds, probs)
expect_equivalent(result$bipartition, c(1,0,0,0))
expect_equivalent(result$probability, c(0.6,0.1,0.4,0.1))
result <- utiml_ensemble_average(preds, probs)
expect_equivalent(result$bipartition, c(1,0,1,0))
expect_equivalent(result$probability, c(0.8, 1.4/3, 2.2/3, 1.3/3))
})
test_that("Check votes and method", {
valids <- c(avg = "utiml_ensemble_average", maj = "utiml_ensemble_majority",
max = "utiml_ensemble_maximum", min = "utiml_ensemble_minimum")
for (schema in names(valids)) {
expect_equal(utiml_ensemble_method(schema), valids[[schema]], schema)
expect_true(utiml_ensemble_check_voteschema(schema))
}
expect_true(utiml_ensemble_check_voteschema(NULL, TRUE))
expect_true(utiml_ensemble_check_voteschema(NULL))
expect_equal(utiml_ensemble_method("other_method"), "other_method")
expect_equal(utiml_ensemble_method("xyz"), "xyz")
expect_error(utiml_ensemble_check_voteschema("other_method"))
expect_error(utiml_ensemble_check_voteschema("xyz"))
expect_error(utiml_ensemble_check_voteschema(NULL, FALSE))
})
test_that("Compute ensemble votes", {
probs <- matrix(
c(1, 1, 1, 1, 0.6, 0.1, 0.8, 0.2, 0.8, 0.3, 0.4, 0.1),
ncol = 3
)
preds <- matrix(
unlist(as.numeric(probs > 0.5)),
ncol = 3
)
# probs preds
# [,1] [,2] [,3] [,1] [,2] [,3]
# [1,] 1 0.6 0.8 [1,] 1 1 1
# [2,] 1 0.1 0.3 [2,] 1 0 0
# [3,] 1 0.8 0.4 [3,] 1 1 0
# [4,] 1 0.2 0.1 [4,] 1 0 0
vmethod <- utiml_ensemble_method("maj")
result <- utiml_compute_ensemble(preds, probs, vmethod, c(1,2,3,4))
expect_is(result, "binary.prediction")
expect_named(result$bipartition, as.character(c(1,2,3,4)))
expect_named(result$probability, as.character(c(1,2,3,4)))
expect_equal(result$bipartition, c(1,0,1,0), check.names = FALSE)
expect_equal(result$probability, c(1,1/3,2/3,1/3), check.names = FALSE)
result <- utiml_compute_ensemble(preds, probs, vmethod, c(4,3,2,1))
expect_named(result$bipartition, as.character(c(4,3,2,1)))
expect_named(result$probability, as.character(c(4,3,2,1)))
})
test_that("Binary ensemble predictions", {
probs <- matrix(
c(1, 1, 1, 1, 0.6, 0.1, 0.8, 0.2, 0.8, 0.3, 0.4, 0.1),
ncol = 3
)
preds <- matrix(
unlist(as.numeric(probs > 0.5)),
ncol = 3
)
# probs preds
# [,1] [,2] [,3] [,1] [,2] [,3]
# [1,] 1 0.6 0.8 [1,] 1 1 1
# [2,] 1 0.1 0.3 [2,] 1 0 0
# [3,] 1 0.8 0.4 [3,] 1 1 0
# [4,] 1 0.2 0.1 [4,] 1 0 0
bpreds <- lapply(seq(ncol(preds)), function (i){
bipartition <- preds[, i]
probability <- probs[, i]
names(bipartition) <- names(probability) <- 1:4
utiml:::utiml_binary_prediction(bipartition, probability)
})
result <- utiml_predict_binary_ensemble(bpreds, "maj")
expect_is(result, "binary.prediction")
expect_named(result$bipartition, as.character(c(1,2,3,4)))
expect_named(result$probability, as.character(c(1,2,3,4)))
expect_equal(result$bipartition, c(1,0,1,0), check.names = FALSE)
expect_equal(result$probability, c(1,1/3,2/3,1/3), check.names = FALSE)
bpreds <- lapply(3, function (i){
bipartition <- preds[, i]
probability <- probs[, i]
names(bipartition) <- names(probability) <- 4:1
utiml_binary_prediction(bipartition, probability)
})
result <- utiml_predict_binary_ensemble(bpreds, "maj")
expect_named(result$bipartition, as.character(c(4,3,2,1)))
expect_named(result$probability, as.character(c(4,3,2,1)))
})
test_that("Ensemble predict", {
pred1 <- utiml_predict(list(
class1 = utiml_binary_prediction(c(1, 1, 1, 1), c(1, 1, 1, 1)),
class2 = utiml_binary_prediction(c(1, 0, 1, 0), c(0.6,0.1,0.8,0.2)),
class3 = utiml_binary_prediction(c(1, 0, 0, 0), c(0.8,0.3,0.4,0.1))
), TRUE)
pred2 <- utiml_predict(list(
class1 = utiml_binary_prediction(c(1, 1, 1, 1), c(1, 1, 1, 1)),
class2 = utiml_binary_prediction(c(1, 0, 1, 0), c(0.6,0.1,0.8,0.2)),
class3 = utiml_binary_prediction(c(1, 0, 0, 0), c(0.8,0.3,0.4,0.1))
), TRUE)
pred3 <- utiml_predict(list(
class1 = utiml_binary_prediction(c(1, 1, 1, 1), c(0.5,0.5,0.5,0.5)),
class2 = utiml_binary_prediction(c(1, 1, 1, 1), c(0.6,0.6,0.6,0.6)),
class3 = utiml_binary_prediction(c(1, 1, 1, 1), c(0.7,0.7,0.7,0.7))
), TRUE)
preds <- list(pred1, pred2, pred3)
result1 <- compute_multilabel_predictions(preds, "maj")
result2 <- compute_multilabel_predictions(preds, "maj", FALSE)
expect_is(result1, "mlresult")
expect_is(result2, "mlresult")
expect_true(all(result1 == attr(result2, "probs")))
expect_true(all(result2 == attr(result1, "classes")))
expect_equal(result2[,1], c(1,1,1,1))
expect_equal(result2[,2], c(1,0,1,0))
expect_equal(result2[,3], c(1,0,0,0))
expect_equal(utiml_predict_ensemble(preds, NULL), preds)
rownames(pred1) <- rownames(pred2) <- rownames(pred3) <- c(11:14)
preds <- list(pred1, pred2, pred3)
result <- compute_multilabel_predictions(preds, "max")
expect_equal(dimnames(result), dimnames(pred1))
expected <- matrix(c(1, 0.6, 0.8, 1, 0.6, 0.7, 1, 0.8, 0.7, 1, 0.6, 0.7),
ncol = 3, byrow = T)
dimnames(expected) <- dimnames(pred1)
expect_equal(result[,1:3], expected)
expect_equal(utiml_predict_ensemble(preds, NULL), preds)
rownames(pred3) <- c(1:4)
expect_error(compute_multilabel_predictions(c(preds, pred3), "maj"))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.