# tests/testthat/test-diffusion-big.R In b2slab/diffuStats: Diffusion scores on biological networks

context("Diffusion functions")

library(igraph)
library(Matrix)
library(Rcpp)

set.seed(1)

# Small example
n <- 1e3
n.perm <- 1e3
n.cores <- 2
seed <- 1

# Directed graph
graph <- barabasi.game(n, directed = F)
V(graph)\$name <- paste0("A", 1:n)

# Random scores
scores <- list(
bkgd1 = as(
matrix(
rbinom(10*n, size = 1, prob = .5),
ncol = 20),
"sparseMatrix")
)
rownames(scores\$bkgd1) <- V(graph)[1:nrow(scores\$bkgd1)]\$name
colnames(scores\$bkgd1) <- paste0("p", 1:ncol(scores\$bkgd1))

# Second set of scores
# background with a different amount of nodes

sample.prob = list(
bkgd1 = (setNames(
degree(graph)[1:(n/2)],
1:(n/2))),
bkgd2 = (setNames(
degree(graph)[1:(n/4)],
1:(n/4))))

test_that("'diffuse_mc' consistency check", {
# Apply main function
expect_error({
heatrank <- diffuse_mc(
graph = graph,
scores = scores,
n.perm = n.perm,
sample.prob = sample.prob,
seed = seed,
oneminusHeatRank = FALSE,
K = NULL)
}, NA)

# Dimensions are as expected
expect_equal(dim(heatrank\$bkgd1), dim(heatrank\$bkgd2))

# heatrank lies between 0 and 1
expect_true(all(heatrank\$bkgd1 >= 0))
expect_true(all(heatrank\$bkgd2 >= 0))

expect_true(all(heatrank\$bkgd1 <= 1))
expect_true(all(heatrank\$bkgd2 <= 1))

# small correction, heatrank should never be zero
expect_false(any(heatrank\$bkgd1 == 0))
})

test_that("'diffuse_raw' consistency check", {
# Apply main function
expect_error({
raw <- diffuse_raw(
graph = graph,
scores = scores,
K = NULL)
}, NA)

# Dimensions are as expected
expect_equal(dim(raw\$bkgd1), dim(raw\$bkgd2))

# As defined, scores should be greater or equal to zero
expect_true(all(raw\$bkgd1 >= 0))
expect_true(all(raw\$bkgd2 >= 0))
})

test_that("'diffuse' consistency check", {
methods_raw <- c("raw", "ml", "gm", "ber_s", "ber_p")
# Try diffusion with several methods
plyr::l_ply(
setNames(methods_raw, methods_raw),
function(method) {
# Apply main function
message(method)
expect_error({
final <- diffuse(
graph = graph,
scores = scores,
method = method,
n.perm = 1e2)
}, NA)

# Dimensions are as expected
expect_equal(dim(final\$bkgd1), dim(final\$bkgd2))
expect_equal(colnames(final\$bkgd1), colnames(scores\$bkgd1))
expect_true(all(rownames(scores\$bkgd1) %in% rownames(final\$bkgd1)))
}
)
})
b2slab/diffuStats documentation built on Oct. 2, 2018, 12:58 p.m.