Skip to content
Snippets Groups Projects
Commit af3969e6 authored by Christian Hohenfeld's avatar Christian Hohenfeld
Browse files

Fix random graph generation.

parent 537c1d8e
No related branches found
No related tags found
No related merge requests found
Package: rsAnalysis
Title: High-Level Tools for rsfMRI analysis
Version: 0.4
Version: 0.4.1
Authors@R:
person(given = "Christian",
family = "Hohenfeld",
......
......@@ -6,28 +6,24 @@
#' @param calc_mean_dist (logical) If TRUE calculates mean_distance for all
#' graphs.
#'
#' If all reference graphs are of the same size, the random graphs will
#' have a size ranging between size / 4 and size / 3.
#'
#' @return A list of tbl_graph objects of length `n`.
#' @export
make_random_graphs <- function(reference_graphs, n, calc_mean_dist = FALSE) {
sizes <- vapply(reference_graphs, igraph::gsize,
degree <- vapply(reference_graphs, function(x) mean(igraph::degree(x)),
numeric(1), USE.NAMES = FALSE)
degree <- round(mean(degree), 0)
order <- vapply(reference_graphs, igraph::gorder,
numeric(1), USE.NAMES = FALSE)
order <- round(mean(order), 0)
min_max_equal <- min(sizes) == max(sizes)
# use https://igraph.org/r/doc/sample_k_regular.html
random_list <- lapply(1:n, function(x)
tidygraph::play_erdos_renyi(
n = order,
m = ifelse(min_max_equal,
sample((sizes[1] / 4):(sizes[1] / 3), 1),
sample(min(sizes):max(sizes), 1)),
directed = FALSE
)
igraph::sample_k_regular(
no.of.nodes = order,
k = degree,
directed = FALSE,
multiple = FALSE
) %>% tidygraph::as_tbl_graph()
)
if (calc_mean_dist) {
......
......@@ -13,10 +13,7 @@ determining the size of the random graphs.}
\item{n}{(int) The amount of graphs to generate.}
\item{calc_mean_dist}{(logical) If TRUE calculates mean_distance for all
graphs.
If all reference graphs are of the same size, the random graphs will
have a size ranging between size / 4 and size / 3.}
graphs.}
}
\value{
A list of tbl_graph objects of length `n`.
......
describe("make_random_graphs", {
data("graph_list")
gl <- lapply(graph_list, function(x) binarise_graph_fixed(x, weight, 0.05))
gl <- lapply(graph_list, function(x) {
x %>%
remove_loops() %>%
remove_duplicate_edges() %>%
binarise_graph_prop(weight, 0.5)
})
it("creates a list of graphs with length n", {
rand <- make_random_graphs(gl, 10)
expect_length(rand, 10)
})
it("creates graphs of varying size, even if input has all equal sizes", {
rand <- make_random_graphs(graph_list, 10)
it("creates graphs of equal size", {
rand <- make_random_graphs(gl, 10)
sizes <- sapply(rand, igraph::gsize)
expect_gt(length(unique(sizes)), 1)
expect_equal(length(unique(sizes)), 1)
})
it("calculates mean distance if requested", {
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment