Nothing
context("Laplacian and Adjacency matrices estimation")
library(testthat)
library(patrick)
library(spectralGraphTopology)
set.seed(42)
test_that("learn_k_component_graph with single component random graph", {
w <- sample(1:10, 6)
Laplacian <- L(w)
n <- ncol(Laplacian)
Y <- MASS::mvrnorm(n * 500, rep(0, n), MASS::ginv(Laplacian))
res <- learn_k_component_graph(cov(Y), record_objective = TRUE, record_weights = TRUE)
expect_true(res$convergence)
expect_true(relative_error(Laplacian, res$laplacian) < 1e-1)
expect_true(metrics(Laplacian, res$laplacian, 1e-1)[1] > .9)
})
with_parameters_test_that("we can recover a simple connected graph with the GLE-MM and GLE-ADMM methods", {
w <- sample(0:10, 6)
Laplacian <- L(w)
n <- ncol(Laplacian)
A_mask <- 1 * (Laplacian < 0)
Y <- MASS::mvrnorm(n * 250, rep(0, n), MASS::ginv(Laplacian))
res <- func(cov(Y), A_mask = A_mask, record_objective = TRUE, reltol = 1e-7)
expect_true(res$convergence)
expect_true(relative_error(Laplacian, res$laplacian) < 2e-1)
expect_true(fscore(Laplacian, res$laplacian, 1e-1) > .8)
},
cases(list(func = learn_laplacian_gle_mm),
list(func = learn_laplacian_gle_admm),
list(func = learn_combinatorial_graph_laplacian))
)
test_that("learn_k_component_graph with diamond graph", {
w <- c(1, 1, 0, 1, 1, 1)
Laplacian <- L(w)
n <- ncol(Laplacian)
Y <- MASS::mvrnorm(n * 1000, rep(0, n), MASS::ginv(Laplacian))
res <- learn_k_component_graph(cov(Y))
expect_true(res$convergence)
expect_true(relative_error(Laplacian, res$laplacian) < 1e-1)
expect_true(metrics(Laplacian, res$laplacian, 1e-1)[1] > .9)
})
test_that("learn_bipartite_graph converges with simple bipartite graph", {
w <- c(1, 0, 0, 1, 0, 1)
Adjacency <- A(w)
n <- ncol(Adjacency)
Y <- MASS::mvrnorm(n * 500, rep(0, n), MASS::ginv(L(w)))
res <- learn_bipartite_graph(cov(Y), w0 = "qp", record_weights = TRUE)
expect_true(res$convergence)
expect_true(relative_error(Adjacency, res$adjacency) < 1e-1)
expect_true(metrics(Adjacency, res$adjacency, 1e-1)[1] > .9)
})
test_that("learn_bipartite_k_component_graph can learn k-component bipartite graph", {
w <- c(1, 0, 0, 1, 0, 1)
Laplacian <- block_diag(L(w), L(w))
n <- ncol(Laplacian)
Y <- MASS::mvrnorm(2 * n * 500, rep(0, n), MASS::ginv(Laplacian))
graph <- learn_bipartite_k_component_graph(cov(Y), k = 2, record_objective = TRUE)
expect_true(graph$convergence)
expect_true(relative_error(Laplacian, graph$laplacian) < 2e-1)
expect_true(metrics(Laplacian, graph$laplacian, 1e-1)[1] > .8)
})
test_that("learn_bipartite_k_component_graph converges with simple bipartite graph", {
w <- c(1, 0, 0, 1, 0, 1)
Adjacency <- A(w)
n <- ncol(Adjacency)
Y <- MASS::mvrnorm(n * 500, rep(0, n), MASS::ginv(L(w)))
res <- learn_bipartite_k_component_graph(cov(Y), w0 = "qp")
expect_true(res$convergence)
expect_true(relative_error(Adjacency, res$adjacency) < 1.5e-1)
expect_true(metrics(Adjacency, res$adjacency, 1e-1)[1] > .9)
})
test_that("learn_k_component_graph with two components", {
Laplacian <- rbind(c(1, -1, 0, 0),
c(-1, 1, 0, 0),
c(0, 0, 1, -1),
c(0, 0, -1, 1))
n <- ncol(Laplacian)
Y <- MASS::mvrnorm(n * 500, rep(0, n), MASS::ginv(Laplacian))
res <- learn_k_component_graph(cov(Y), k = 2, beta = 10)
expect_true(res$convergence)
expect_true(relative_error(Laplacian, res$laplacian) < 1e-1)
expect_true(metrics(Laplacian, res$laplacian, 1e-1)[1] > .9)
})
test_that("check that learn_bipartite_k_component_graph and learn_k_component_graph are consistent", {
w <- c(1, 0, 0, 1, 0, 1)
Laplacian <- L(w)
n <- ncol(Laplacian)
Y <- MASS::mvrnorm(n * 100, rep(0, n), MASS::ginv(Laplacian))
S <- cov(Y)
res1 <- learn_bipartite_k_component_graph(S, w0 = "qp", beta = 10, nu = 0)
res2 <- learn_k_component_graph(S, w0 = "qp", beta = 10)
expect_true(res1$convergence)
expect_true(res2$convergence)
expect_true(all(abs(res1$obj_fun - res2$obj_fun) < 1e-9))
expect_true(all(abs(res1$w - res2$w) < 1e-9))
})
test_that("learn_k_component_graph with two components graph #2", {
Laplacian1 <- L(runif(3))
Laplacian2 <- L(runif(6))
n1 <- ncol(Laplacian1)
n2 <- ncol(Laplacian2)
Laplacian <- block_diag(Laplacian1, Laplacian2)
Y <- MASS::mvrnorm(500 * (n1 + n2), rep(0, n1 + n2), MASS::ginv(Laplacian))
res <- learn_k_component_graph(cov(Y), k = 2)
expect_true(res$convergence)
expect_true(relative_error(Laplacian, res$laplacian) < 2e-1)
expect_true(metrics(Laplacian, res$laplacian, 1e-1)[1] > .8)
})
test_that("learn_bipartite_k_component_graph with two components graph #2", {
Laplacian1 <- L(runif(3))
Laplacian2 <- L(runif(6))
n1 <- ncol(Laplacian1)
n2 <- ncol(Laplacian2)
Laplacian <- block_diag(Laplacian1, Laplacian2)
Y <- MASS::mvrnorm(500 * (n1 + n2), rep(0, n1 + n2), MASS::ginv(Laplacian))
res <- learn_bipartite_k_component_graph(cov(Y), k = 2, w0 = "qp", nu = 0, eigtol = 1e-5)
expect_true(res$convergence)
expect_true(relative_error(Laplacian, res$laplacian) < 2e-1)
expect_true(metrics(Laplacian, res$laplacian, 1e-1)[1] > .8)
})
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.