From 4b036df7214ce675ed2131e8479a887738347270 Mon Sep 17 00:00:00 2001 From: TomKellyGenetics Date: Tue, 24 Nov 2020 08:52:56 +0900 Subject: [PATCH] tests for multiplex graphs #7 --- R/leiden.R | 41 +++++- R/py_objects.R | 38 ++++- tests/testthat/test_multiplex.R | 247 ++++++++++++++++++++++++++++++++ 3 files changed, 318 insertions(+), 8 deletions(-) create mode 100644 tests/testthat/test_multiplex.R diff --git a/R/leiden.R b/R/leiden.R index 9506cf8..4556a88 100644 --- a/R/leiden.R +++ b/R/leiden.R @@ -127,12 +127,32 @@ leiden.matrix <- function(object, laplacian = FALSE, legacy = FALSE ) { + if(length(partition_type) > 1) partition_type <- partition_type[[1]][1] + partition_type <- match.arg(partition_type) + #import python modules with reticulate numpy <- import("numpy", delay_load = TRUE) leidenalg <- import("leidenalg", delay_load = TRUE) ig <- import("igraph", delay_load = TRUE) - py_graph <- make_py_object(object, weights = weights) + #convert matrix input (corrects for sparse matrix input) + if(is.matrix(object) || is(object, "dgCMatrix")){ + object <- object + } else{ + object <- as.matrix(object) + } + + #compute weights if non-binary adjacency matrix given + is_pure_adj <- all(as.logical(object) == object) + if (is.null(weights) && !is_pure_adj) { + if(!is.matrix(object)) object <- as.matrix(object) + #assign weights to edges (without dependancy on igraph) + t_mat <- t(object) + weights <- t_mat[t_mat!=0] + #remove zeroes from rows of matrix and return vector of length edges + } + + py_graph <- make_py_graph(object, weights = weights) #compute partitions partition <- find_partition(py_graph, partition_type = partition_type, @@ -176,6 +196,9 @@ leiden.Matrix <- function(object, laplacian = FALSE, legacy = FALSE ) { + if(length(partition_type) > 1) partition_type <- partition_type[[1]][1] + partition_type <- match.arg(partition_type) + #cast to sparse matrix adj_mat <- as(object, "dgCMatrix") #run as igraph object (passes to reticulate) @@ -243,8 +266,14 @@ leiden.list <- function(object, legacy = legacy ) } else{ - py_list <- r_to_py(lapply(object, make_py_graph)) + #import python modules with reticulate + numpy <- reticulate::import("numpy", delay_load = TRUE) + leidenalg <- import("leidenalg", delay_load = TRUE) + ig <- import("igraph", delay_load = TRUE) + py_list <- r_to_py(lapply(object, function(r_graph){ + make_py_graph(r_graph, weights = weights) + })) if(partition_type == 'ModularityVertexPartition.Bipartite') partition_type <- "ModularityVertexPartition" if(partition_type == 'CPMVertexPartition.Bipartite') partition_type <- "CPMVertexPartition" @@ -294,6 +323,10 @@ leiden.igraph <- function(object, if(length(partition_type) > 1) partition_type <- partition_type[[1]][1] partition_type <- match.arg(partition_type) + #import python modules with reticulate + numpy <- reticulate::import("numpy", delay_load = TRUE) + leidenalg <- import("leidenalg", delay_load = TRUE) + ig <- import("igraph", delay_load = TRUE) #pass weights to igraph if not found if(!is_weighted(object) && !is.null(weights)){ @@ -444,6 +477,7 @@ numpy <- NULL install.packages("devtools", quiet = TRUE) devtools::install_github("rstudio/reticulate", ref = "86ebb56", quiet = TRUE) if(!reticulate::py_module_available("numpy")) suppressWarnings(suppressMessages(reticulate::conda_install(envname = "r-reticulate", packages = "numpy"))) + if(!reticulate::py_module_available("pandas")) suppressWarnings(suppressMessages(reticulate::conda_install(envname = "r-reticulate", packages = "pandas"))) if(!reticulate::py_module_available("igraph")) suppressWarnings(suppressMessages(reticulate::conda_install(envname = "r-reticulate", packages = "python-igraph"))) if(!reticulate::py_module_available("mkl")) suppressWarnings(suppressMessages(reticulate::conda_install(envname = "r-reticulate", packages = "mkl", channel = "intel"))) if(!reticulate::py_module_available("umap")) suppressWarnings(suppressMessages(reticulate::conda_install(envname = "r-reticulate", packages = "umap-learn", channel = "conda-forge"))) @@ -453,6 +487,7 @@ numpy <- NULL utils::install.packages("reticulate", quiet = TRUE) } else { if(!reticulate::py_module_available("numpy")) suppressWarnings(suppressMessages(reticulate::conda_install("r-reticulate", "numpy"))) + if(!reticulate::py_module_available("pandas")) suppressWarnings(suppressMessages(reticulate::conda_install(envname = "r-reticulate", packages = "pandas"))) if(!reticulate::py_module_available("igraph")) suppressWarnings(suppressMessages(reticulate::conda_install("r-reticulate", "python-igraph"))) if(!reticulate::py_module_available("umap")) suppressWarnings(suppressMessages(reticulate::conda_install("r-reticulate", "umap-learn", forge = TRUE))) if(!reticulate::py_module_available("leidenalg")) suppressWarnings(suppressMessages(reticulate::conda_install("r-reticulate", "leidenalg", forge = TRUE))) @@ -471,6 +506,7 @@ numpy <- NULL # system("conda init") # system("conda activate r-reticulate") if(!reticulate::py_module_available("numpy")) suppressWarnings(suppressMessages(reticulate::py_install("numpy"))) + if(!reticulate::py_module_available("pandas")) suppressWarnings(suppressMessages(reticulate::conda_install(envname = "r-reticulate", packages = "pandas"))) if(!reticulate::py_module_available("igraph")) suppressWarnings(suppressMessages(reticulate::py_install("python-igraph", method = method, conda = conda))) if(!reticulate::py_module_available("umap")) suppressWarnings(suppressMessages(reticulate::py_install("umap-learn"))) if(!reticulate::py_module_available("leidenalg")) suppressWarnings(suppressMessages(reticulate::py_install("leidenalg", method = method, conda = conda, forge = TRUE))) @@ -507,6 +543,7 @@ numpy <- NULL if (modules) { ## assignment in parent environment! numpy <- reticulate::import("numpy", delay_load = TRUE) + pd <- reticulate::import("pandas", delay_load = TRUE) leidenalg <- reticulate::import("leidenalg", delay_load = TRUE) ig <- reticulate::import("igraph", delay_load = TRUE) } diff --git a/R/py_objects.R b/R/py_objects.R index 21004a8..93ee966 100644 --- a/R/py_objects.R +++ b/R/py_objects.R @@ -16,23 +16,23 @@ make_py_object.matrix <- function(object, weights = NULL){ #convert matrix input (corrects for sparse matrix input) if(is.matrix(object) || is(object, "dgCMatrix")){ - adj_mat <- object + object <- object } else{ - adj_mat <- as.matrix(object) + object <- as.matrix(object) } #compute weights if non-binary adjacency matrix given - is_pure_adj <- all(as.logical(adj_mat) == adj_mat) + is_pure_adj <- all(as.logical(object) == object) if (is.null(weights) && !is_pure_adj) { - if(!is.matrix(object)) adj_mat <- as.matrix(adj_mat) + if(!is.matrix(object)) object <- as.matrix(object) #assign weights to edges (without dependancy on igraph) - t_mat <- t(adj_mat) + t_mat <- t(object) weights <- t_mat[t_mat!=0] #remove zeroes from rows of matrix and return vector of length edges } ##convert to python numpy.ndarray, then a list - adj_mat_py <- r_to_py(adj_mat, convert = T) + adj_mat_py <- r_to_py(object, convert = TRUE) if(is(object, "dgCMatrix")){ adj_mat_py <- adj_mat_py$toarray() } @@ -74,11 +74,34 @@ make_py_object.igraph <- function(object, weights = NULL){ py_graph } +make_py_object.data.frame <- function(object, weights = NULL){ + pd <- reticulate::import("pandas", delay_load = TRUE) + adj_df_py <- pd$DataFrame(data = r_to_py(object, convert = TRUE)) + + adj_df_py +} + +##' convert to python igraph object +##' @param object an igraph object or matrix +##' @param weights Parameters to pass to the Python leidenalg function (defaults initial_membership=None, weights=None). Weights are derived from weighted igraph objects and non-zero integer values of adjacency matrices. +##' @noRd +##' @description internal function to compute partitions by calling Python with reticulate +##' @keywords internal make_py_graph <- function(object, weights = NULL) { UseMethod("make_py_graph", object) } make_py_graph.matrix <- function(object, weights = NULL){ + #compute weights if non-binary adjacency matrix given + is_pure_adj <- all(as.logical(object) == object) + if (is.null(weights) && !is_pure_adj) { + if(!is.matrix(object)) object <- as.matrix(object) + #assign weights to edges (without dependancy on igraph) + t_mat <- t(object) + weights <- t_mat[t_mat!=0] + #remove zeroes from rows of matrix and return vector of length edges + } + #import python modules with reticulate numpy <- reticulate::import("numpy", delay_load = TRUE) leidenalg <- import("leidenalg", delay_load = TRUE) @@ -97,3 +120,6 @@ make_py_graph.matrix <- function(object, weights = NULL){ make_py_graph.igraph <- make_py_object.igraph +make_py_graph.data.frame <- function(object, weights = NULL){ + py_graph <- make_py_graph(as.matrix(object), weights = weights) +} diff --git a/tests/testthat/test_multiplex.R b/tests/testthat/test_multiplex.R new file mode 100644 index 0000000..859f1dd --- /dev/null +++ b/tests/testthat/test_multiplex.R @@ -0,0 +1,247 @@ +library("reticulate") +library("igraph") +library("leiden") +library("multiplex") + +context("running Leiden on multiplex igraph objects") + +suppressWarnings(suppressMessages({ + #imported from Achab94/mplex::aarhus_mplex + multiplex_mplex <- list(nodes = structure(list(nodeID = 1:61, nodeLabel = structure(c(3L, + 18L, 33L, 4L, 5L, 10L, 11L, 1L, 26L, 27L, 29L, 30L, 32L, 36L, + 37L, 40L, 43L, 60L, 12L, 23L, 51L, 56L, 58L, 6L, 13L, 15L, 16L, + 24L, 31L, 38L, 42L, 45L, 54L, 55L, 57L, 61L, 2L, 14L, 22L, 19L, + 25L, 28L, 34L, 35L, 53L, 7L, 9L, 17L, 41L, 47L, 48L, 52L, 8L, + 39L, 49L, 50L, 46L, 44L, 59L, 20L, 21L), + .Label = c("U1", "U10", + "U102", "U106", "U107", "U109", "U110", "U112", "U113", "U118", + "U123", "U124", "U126", "U13", "U130", "U134", "U138", "U139", + "U14", "U140", "U141", "U142", "U17", "U18", "U19", "U21", "U22", + "U23", "U26", "U29", "U3", "U32", "U33", "U37", "U4", "U41", + "U42", "U47", "U48", "U49", "U53", "U54", "U59", "U6", "U62", + "U63", "U65", "U67", "U68", "U69", "U71", "U72", "U73", "U76", + "U79", "U86", "U90", "U91", "U92", "U97", "U99"), class = "factor")), + class = "data.frame", + row.names = c(NA, -61L)), layerNames = c("lunch", "facebook", "coauthor", "leisure", "work"), + L1 = structure(list(ID_Start = c(1L, 1L, 10L, 10L, 10L, + 10L, 11L, 11L, 11L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 14L, 15L, + 15L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 18L, 18L, 18L, 18L, 18L, + 18L, 19L, 19L, 19L, 19L, 20L, 20L, 20L, 21L, 21L, 21L, 22L, 23L, + 23L, 23L, 23L, 23L, 23L, 24L, 24L, 24L, 24L, 24L, 24L, 24L, 24L, + 24L, 24L, 24L, 25L, 25L, 25L, 25L, 25L, 25L, 25L, 25L, 25L, 26L, + 26L, 26L, 26L, 27L, 27L, 27L, 27L, 27L, 27L, 27L, 27L, 27L, 27L, + 28L, 28L, 28L, 28L, 28L, 28L, 28L, 29L, 29L, 29L, 29L, 29L, 3L, + 3L, 3L, 3L, 3L, 30L, 30L, 31L, 31L, 31L, 31L, 32L, 32L, 32L, + 33L, 33L, 33L, 34L, 34L, 34L, 35L, 37L, 37L, 38L, 38L, 39L, 4L, + 4L, 4L, 4L, 4L, 4L, 4L, 40L, 40L, 40L, 41L, 41L, 42L, 43L, 43L, + 43L, 44L, 44L, 44L, 44L, 44L, 44L, 44L, 46L, 46L, 46L, 47L, 47L, + 47L, 48L, 49L, 49L, 5L, 5L, 5L, 50L, 50L, 51L, 51L, 52L, 53L, + 53L, 54L, 54L, 54L, 55L, 55L, 56L, 59L, 6L, 6L, 6L, 6L, 6L, 7L, + 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, + 9L), ID_Arrive = c(2L, 3L, 11L, 14L, 15L, 16L, 14L, 15L, 16L, + 13L, 20L, 40L, 20L, 26L, 40L, 45L, 15L, 16L, 30L, 23L, 25L, 46L, + 49L, 50L, 51L, 52L, 21L, 25L, 43L, 44L, 56L, 58L, 24L, 25L, 30L, + 36L, 40L, 42L, 45L, 44L, 51L, 57L, 26L, 25L, 46L, 49L, 50L, 51L, + 52L, 25L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 31L, + 35L, 43L, 46L, 47L, 48L, 52L, 56L, 58L, 27L, 34L, 44L, 46L, 31L, + 32L, 33L, 34L, 35L, 36L, 38L, 44L, 54L, 59L, 29L, 31L, 32L, 33L, + 34L, 35L, 36L, 31L, 32L, 33L, 34L, 35L, 21L, 44L, 51L, 57L, 7L, + 34L, 36L, 32L, 33L, 34L, 35L, 33L, 34L, 35L, 34L, 35L, 36L, 35L, + 36L, 57L, 58L, 40L, 41L, 39L, 44L, 44L, 10L, 11L, 14L, 15L, 16L, + 18L, 6L, 41L, 42L, 45L, 42L, 45L, 45L, 51L, 56L, 58L, 51L, 53L, + 54L, 55L, 57L, 59L, 61L, 47L, 49L, 52L, 48L, 51L, 52L, 52L, 50L, + 52L, 12L, 13L, 20L, 51L, 52L, 52L, 57L, 56L, 54L, 55L, 55L, 59L, + 61L, 59L, 61L, 58L, 61L, 10L, 11L, 14L, 15L, 16L, 21L, 34L, 44L, + 51L, 57L, 12L, 13L, 37L, 40L, 41L, 42L, 45L, 18L, 25L, 43L, 51L, + 56L, 58L), Weight = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L)), row.names = c(NA, 193L), class = "data.frame"), + L2 = structure(list(ID_Start = c(12L, 12L, 13L, 13L, 13L, + 13L, 13L, 13L, 15L, 15L, 15L, 17L, 17L, 17L, 17L, 19L, 19L, + 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 21L, 21L, + 21L, 21L, 23L, 23L, 23L, 23L, 23L, 23L, 23L, 23L, 23L, 24L, + 24L, 24L, 24L, 24L, 26L, 26L, 26L, 26L, 26L, 26L, 26L, 26L, + 26L, 28L, 28L, 28L, 28L, 28L, 29L, 29L, 29L, 29L, 30L, 30L, + 30L, 30L, 30L, 31L, 31L, 31L, 31L, 31L, 33L, 33L, 33L, 34L, + 34L, 34L, 37L, 37L, 39L, 39L, 39L, 4L, 4L, 4L, 4L, 4L, 4L, + 4L, 44L, 44L, 46L, 46L, 47L, 47L, 47L, 5L, 5L, 5L, 5L, 50L, + 51L, 51L, 56L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, + 8L, 8L, 8L, 8L, 9L, 9L, 9L), + ID_Arrive = c(13L, 23L, 21L, + 23L, 26L, 44L, 46L, 51L, 16L, 34L, 39L, 23L, 46L, 47L, 51L, + 23L, 24L, 26L, 27L, 28L, 29L, 30L, 31L, 33L, 34L, 56L, 58L, + 34L, 44L, 46L, 51L, 34L, 37L, 39L, 44L, 46L, 47L, 50L, 51L, + 56L, 28L, 30L, 31L, 33L, 34L, 27L, 28L, 29L, 30L, 33L, 34L, + 39L, 44L, 51L, 29L, 30L, 31L, 33L, 34L, 30L, 31L, 33L, 34L, + 31L, 33L, 34L, 39L, 44L, 33L, 34L, 37L, 39L, 44L, 34L, 44L, + 53L, 39L, 46L, 50L, 39L, 44L, 44L, 46L, 51L, 12L, 13L, 17L, + 5L, 7L, 8L, 9L, 46L, 51L, 47L, 51L, 50L, 51L, 56L, 12L, 13L, + 19L, 21L, 53L, 56L, 58L, 58L, 13L, 15L, 16L, 21L, 23L, 26L, + 30L, 39L, 44L, 51L, 12L, 13L, 21L, 34L, 37L, 51L, 56L, 58L + ), + Weight = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L)), row.names = 194:317, class = "data.frame"), + L3 = structure(list(ID_Start = c(10L, 12L, 18L, 23L, 23L, + 23L, 26L, 26L, 26L, 26L, 26L, 28L, 30L, 38L, 39L, 4L, 46L, + 46L, 49L, 6L, 8L), + ID_Arrive = c(11L, 13L, 46L, 46L, 49L, + 52L, 27L, 28L, 30L, 33L, 36L, 33L, 36L, 54L, 55L, 6L, 48L, + 49L, 52L, 14L, 37L), + Weight = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L)), row.names = 318:338, class = "data.frame"), + L4 = structure(list(ID_Start = c(10L, 12L, 12L, 15L, 15L, + 15L, 17L, 17L, 17L, 17L, 19L, 19L, 19L, 19L, 20L, 20L, 20L, + 20L, 23L, 23L, 23L, 23L, 23L, 23L, 23L, 23L, 23L, 23L, 24L, + 24L, 24L, 24L, 25L, 25L, 25L, 25L, 28L, 28L, 28L, 29L, 29L, + 30L, 31L, 31L, 31L, 31L, 32L, 33L, 33L, 34L, 34L, 34L, 34L, + 35L, 37L, 37L, 37L, 37L, 39L, 39L, 4L, 4L, 40L, 40L, 40L, + 41L, 41L, 42L, 44L, 46L, 46L, 46L, 46L, 47L, 47L, 48L, 5L, + 5L, 5L, 50L, 55L, 6L, 8L, 8L, 8L, 8L, 8L, 9L), + ID_Arrive = c(15L, + 13L, 25L, 16L, 34L, 39L, 23L, 46L, 50L, 52L, 23L, 25L, 28L, + 36L, 23L, 40L, 42L, 45L, 25L, 31L, 35L, 46L, 47L, 48L, 49L, + 50L, 52L, 56L, 25L, 31L, 33L, 35L, 31L, 35L, 46L, 56L, 32L, + 33L, 36L, 31L, 35L, 33L, 33L, 34L, 35L, 37L, 33L, 34L, 35L, + 35L, 36L, 45L, 50L, 58L, 38L, 39L, 43L, 45L, 43L, 55L, 14L, + 6L, 41L, 42L, 45L, 42L, 45L, 45L, 51L, 47L, 48L, 50L, 51L, + 48L, 50L, 52L, 13L, 20L, 23L, 52L, 61L, 14L, 11L, 37L, 40L, + 42L, 45L, 25L), + Weight = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L)), row.names = 339:426, class = "data.frame"), + L5 = structure(list(ID_Start = c(10L, 10L, 10L, 10L, 11L, + 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 12L, 12L, 13L, 13L, + 13L, 13L, 13L, 13L, 13L, 15L, 17L, 17L, 17L, 18L, 18L, 18L, + 19L, 19L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 20L, + 20L, 20L, 21L, 21L, 21L, 21L, 21L, 21L, 21L, 21L, 23L, 23L, + 23L, 23L, 23L, 23L, 23L, 24L, 24L, 24L, 25L, 25L, 25L, 26L, + 26L, 26L, 26L, 26L, 26L, 26L, 26L, 26L, 26L, 27L, 27L, 28L, + 29L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 30L, 30L, 31L, 31L, + 31L, 31L, 31L, 32L, 33L, 34L, 34L, 34L, 35L, 36L, 37L, 37L, + 37L, 37L, 38L, 38L, 38L, 39L, 39L, 4L, 4L, 4L, 4L, 40L, 40L, + 40L, 41L, 41L, 42L, 43L, 44L, 44L, 44L, 44L, 44L, 44L, 44L, + 46L, 46L, 46L, 46L, 46L, 47L, 47L, 48L, 5L, 5L, 5L, 5L, 5L, + 50L, 50L, 51L, 51L, 51L, 51L, 53L, 54L, 55L, 6L, 6L, 6L, + 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, + 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, + 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 9L), + ID_Arrive = c(11L, 14L, + 15L, 16L, 13L, 15L, 16L, 18L, 21L, 26L, 34L, 46L, 60L, 13L, + 20L, 18L, 20L, 22L, 26L, 40L, 45L, 46L, 34L, 23L, 46L, 51L, + 21L, 44L, 51L, 26L, 44L, 11L, 12L, 18L, 21L, 37L, 40L, 41L, + 5L, 51L, 7L, 8L, 40L, 42L, 45L, 40L, 41L, 44L, 46L, 51L, + 57L, 58L, 60L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 26L, 31L, + 32L, 46L, 51L, 56L, 27L, 28L, 30L, 31L, 32L, 33L, 34L, 36L, + 37L, 44L, 36L, 44L, 32L, 35L, 11L, 21L, 44L, 46L, 51L, 57L, + 6L, 7L, 9L, 32L, 36L, 34L, 35L, 38L, 41L, 44L, 33L, 44L, + 36L, 44L, 46L, 44L, 44L, 40L, 41L, 42L, 45L, 44L, 54L, 59L, + 44L, 55L, 11L, 14L, 6L, 7L, 41L, 42L, 45L, 42L, 45L, 45L, + 51L, 51L, 53L, 54L, 55L, 57L, 59L, 61L, 47L, 48L, 49L, 51L, + 52L, 48L, 51L, 51L, 12L, 13L, 20L, 21L, 22L, 51L, 52L, 52L, + 56L, 57L, 58L, 55L, 56L, 61L, 11L, 14L, 18L, 21L, 35L, 51L, + 7L, 10L, 11L, 15L, 16L, 18L, 19L, 20L, 21L, 26L, 28L, 29L, + 30L, 31L, 32L, 33L, 34L, 35L, 36L, 39L, 44L, 46L, 51L, 57L, + 11L, 13L, 19L, 21L, 26L, 34L, 37L, 40L, 41L, 42L, 45L, 51L + ), + Weight = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, + 1L, 1L, 1L)), row.names = 427:620, class = "data.frame")) + + lunch <- graph_from_edgelist(as.matrix(multiplex_mplex[[3]][,1:2])) + V(lunch)$name <- as.character(multiplex_mplex[[1]][,2]) + facebook <- graph_from_edgelist(as.matrix(multiplex_mplex[[4]][,1:2])) + facebook <- graph_from_edgelist( + rbind(as.matrix(multiplex_mplex[[4]][,1:2]), + cbind(setdiff(as.integer(V(lunch)), as.integer(V(facebook))), + setdiff(as.integer(V(lunch)), as.integer(V(facebook)))) + ) + ) + V(facebook)$name <- as.character(multiplex_mplex[[1]][,2]) + coauthor <- graph_from_edgelist(as.matrix(multiplex_mplex[[5]][,1:2])) + coauthor <- graph_from_edgelist( + rbind(as_edgelist(coauthor), + cbind(setdiff(as.integer(V(lunch)), as.integer(V(coauthor))), + setdiff(as.integer(V(lunch)), as.integer(V(coauthor)))) + ) + ) + leisure <- graph_from_edgelist(as.matrix(multiplex_mplex[[6]][,1:2])) + V(leisure)$name <- as.character(multiplex_mplex[[1]][,2]) + work <- graph_from_edgelist(as.matrix(multiplex_mplex[[7]][,1:2])) + V(work)$name <- as.character(multiplex_mplex[[1]][,2]) + + multiplex_graph <- list(lunch, facebook, coauthor, leisure, work) + multiplex_graph <- lapply(multiplex_graph, upgrade_graph) +})) + +multiplex_adj_mat <- lapply(multiplex_graph, igraph::as_adjacency_matrix) + +modules <- reticulate::py_module_available("leidenalg") && reticulate::py_module_available("igraph") + +skip_if_no_python <- function() { + if (!modules) + testthat::skip("leidenalg not available for testing") +} + + +test_that("run with CPMVertexPartition multiplexed", { + skip_if_no_python() + partition <- leiden(multiplex_graph, + partition_type = "CPMVertexPartition", + resolution_parameter = 0.1, + seed = 9001) + expect_length(partition, length(V(multiplex_graph[[1]]))) + expect_equal(sort(unique(partition)), c(1:10)) + expect_equal(partition, + c(8, 2, 7, 5, 2, 5, 1, 2, 6, 5, 5, 2, 2, 5, 5, 5, 3, 6, 1, 2, + 7, 10, 3, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 4, 4, 2, + 2, 2, 6, 4, 2, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 6, 7, 6, 4, 9, 4 + )) + multiplex_graph +}) + +test_that("run with ModularityVertexPartition multiplexed", { + skip_if_no_python() + partition <- leiden(multiplex_graph, + partition_type = "ModularityVertexPartition", + resolution_parameter = 0.1, + degree_as_node_size = TRUE, + seed = 9001) + expect_length(partition, length(V(multiplex_graph[[1]]))) + expect_equal(sort(unique(partition)), 1:6) + expect_equal(partition, + c(3, 3, 1, 4, 3, 4, 4, 3, 1, 4, 4, 3, 3, 4, 4, 4, 1, 1, 2, 3, + 1, 3, 1, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 5, 5, 3, 3, + 3, 1, 5, 3, 1, 1, 1, 1, 1, 1, 1, 5, 5, 5, 1, 1, 1, 5, 6, 5)) +})