Merge pull request #249 from snlab-ch/develop

v0.12.2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: migraph
 Title: Tools for Multimodal Network Analysis
-Version: 0.12.1
-Date: 2022-10-03
+Version: 0.12.2
+Date: 2022-10-12
 Description: A set of tools for analysing multimodal networks.
    All functions operate with matrices, edge lists, 
    and 'igraph', 'network', and 'tidygraph' objects,

NAMESPACE

@@ -293,6 +293,7 @@ export(is_complex)
 export(is_connected)
 export(is_directed)
 export(is_edgelist)
+export(is_eulerian)
 export(is_graph)
 export(is_labelled)
 export(is_migraph)
@@ -357,11 +358,15 @@ export(node_core)
 export(node_coreness)
 export(node_cuts)
 export(node_degree)
+export(node_diversity)
+export(node_edge_betweenness)
 export(node_efficiency)
 export(node_effsize)
 export(node_eigenvector)
 export(node_equivalence)
+export(node_fast_greedy)
 export(node_hierarchy)
+export(node_homophily)
 export(node_is_core)
 export(node_is_cutpoint)
 export(node_is_isolate)
@@ -374,12 +379,15 @@ export(node_path_census)
 export(node_power)
 export(node_quad_census)
 export(node_reach)
+export(node_reciprocity)
 export(node_redundancy)
 export(node_regular_equivalence)
 export(node_strong_components)
 export(node_structural_equivalence)
 export(node_tie_census)
+export(node_transitivity)
 export(node_triad_census)
+export(node_walktrap)
 export(node_weak_components)
 export(read_edgelist)
 export(read_nodelist)

NEWS.md

@@ -1,3 +1,42 @@
+# migraph 0.12.2
+
+## Package
+
+- Fixed several typos in the centrality vignette and reexported figures
+- Added community detection vignette
+
+## Make
+
+- `create_lattice()` now conforms to other `create_*()` functions in how it interprets `"n"`
+  - from an inferred `"n"` for a one-mode network, it will create a transitive lattice of as even dimensions as possible
+  - for a two-mode network, this depends on how balanced the two modes are, and is still a work in progress... (WIP)
+
+## Marks
+
+- Added `is_eulerian()` for a logical expression of whether the network has an Eulerian path
+
+## Measures
+
+- `network_smallworld()` now takes a method argument for different ways of calculating a small-world coefficient
+  - "omega" (the new default) offers a better range, 0 to 1, than the previous (now "sigma") metric.
+  - "SWI" is also included and offers a 0 to 1 range, but where 1 may not be realisable
+- Added `node_diversity()` for calculating heterogeneity among each nodes' ego network
+- Added `node_homophily()` for calculating homophilous ties among each nodes' ego network
+- Added `node_reciprocity()` for calculating each node's reciprocity
+- Added `node_transitivity()` for calculating each node's transitivity/clustering
+
+## Memberships
+
+- Added wrappers for several community detection algorithms from igraph,
+  unlike tidygraph these can operate on objects directly
+  - Added `node_walktrap()`
+  - Added `node_edge_betweenness()`
+  - Added `node_fast_greedy()`
+
+## Mapping
+
+- Reversed blue/red colour assignment for binary variables
+
 # migraph 0.12.1
 
 ## Manipulations
@@ -19,7 +58,7 @@
 
 ## Mapping
 
-- Fixed `autographr()` tests to work with new version of `{ggraph}`
+- Fixed `autographr()` tests to work with new version of `{ggraph}` (closed #247, thanks @henriquesposito)
 
 # migraph 0.12.0
 

R/make_create.R

@@ -89,11 +89,6 @@ create_complete <- function(n, directed = FALSE) {
 create_ring <- function(n, width = 1, directed = FALSE, ...) {
   n <- infer_n(n)
 
-  # Helper function
-  roll_over <- function(w) {
-    cbind(w[, ncol(w)], w[, 1:(ncol(w) - 1)])
-  }
-
   if (length(n) == 1) {
     if (width == 1) {
      out <- igraph::make_ring(n, directed, ...)
@@ -203,13 +198,39 @@ create_tree <- function(n,
 #' @importFrom igraph make_lattice
 #' @examples
 #' autographr(create_lattice(5), layout = "kk") +
-#' autographr(create_lattice(c(5,5))) +
-#' autographr(create_lattice(c(5,5,5)))
+#' autographr(create_lattice(c(5,5)))
 #' @export
 create_lattice <- function(n,
                            directed = FALSE) {
-  if (is_migraph(n)) n <- network_dims(n)
-  igraph::make_lattice(n, directed = directed)
+  n <- infer_n(n)
+
+  divisors <- function(x){
+    y <- seq_len(x)
+    y[ x%%y == 0 ]
+  }
+
+  if(length(n)== 1){
+    divs <- divisors(n)
+    if((length(divs) %% 2) == 0){
+      dims <- c(divs[length(divs)/2], divs[length(divs)/2+1])
+    } else dims <- c(median(divs), median(divs))
+    igraph::make_lattice(dims, nei = 2, directed = directed)
+  } else {
+    divs1 <- divisors(n[1])
+    divs2 <- divisors(n[2])
+    divs1 <- divs1[-c(1, length(divs1))]
+    divs2 <- divs2[-c(1, length(divs2))]
+    divs1 <- intersect(divs1, c(divs2+1, divs2-1))
+    divs2 <- intersect(divs2, c(divs1+1, divs1-1))
+    mat <- matrix(0, n[1], n[2])
+    diag(mat) <- 1
+    w <- roll_over(mat)
+    mat <- mat + w
+    mat[lower.tri(mat)] <- 0
+    out <- mat[rowSums(mat)==2,]
+    out <- do.call(rbind, replicate(nrow(mat)/nrow(out), out, simplify=FALSE))
+    as_igraph(out)
+  }
 }
 
 #' @describeIn create Creates a graph in which the nodes are clustered
@@ -311,3 +332,7 @@ infer_membership <- function(n, membership) {
   }
   membership
 }
+
+roll_over <- function(w) {
+  cbind(w[, ncol(w)], w[, 1:(ncol(w) - 1)])
+}

R/mark_is.R

@@ -372,3 +372,13 @@ is_perfect_matching <- function(object, mark = "type"){
   matches <- to_matching(object, mark = mark)
   network_ties(matches)*2 == network_nodes(matches)
 }
+
+#' @describeIn is Tests whether there is a Eulerian path for a network
+#'   where that path passes through every tie exactly once
+#'   @importFrom igraph has_eulerian_path
+#' @examples
+#' is_eulerian(ison_brandes)
+#' @export
+is_eulerian <- function(object){
+  igraph::has_eulerian_path(as_igraph(object))
+}

R/measure_closure.R

@@ -40,16 +40,36 @@ network_reciprocity <- function(object, method = "default") {
                      object)
 }
 
+#' @describeIn closure Calculate nodes' reciprocity
+#' @examples
+#' node_reciprocity(to_unweighted(ison_networkers))
+#' @export
+node_reciprocity <- function(object) {
+  out <- as_matrix(object)
+  make_node_measure(rowSums(out * t(out))/rowSums(out), 
+                    object)
+}
+
 #' @describeIn closure Calculate transitivity in a network
 #' @importFrom igraph transitivity
 #' @examples
-#' network_transitivity(ison_southern_women)
+#' network_transitivity(ison_adolescents)
 #' @export
 network_transitivity <- function(object) {
   make_network_measure(igraph::transitivity(as_igraph(object)), 
                      object)
 }
 
+#' @describeIn closure Calculate nodes' transitivity
+#' @examples
+#' node_transitivity(ison_adolescents)
+#' @export
+node_transitivity <- function(object) {
+  make_node_measure(igraph::transitivity(as_igraph(object), 
+                                         type = "local"), 
+                       object)
+}
+
 #' @describeIn closure Calculate equivalence or reinforcement 
 #'   in a (usually two-mode) network
 #' @examples

R/measure_diversity.R

@@ -58,8 +58,23 @@ network_diversity <- function(object, attribute, clusters = NULL){
   make_network_measure(blauout, object)
 }
 
-#' @describeIn diversity Calculates the embeddedness of a node within the group
-#'    of nodes of the same attribute
+#' @describeIn diversity Calculates the heterogeneity of each node's
+#'   local neighbourhood.
+#' @examples 
+#' node_diversity(marvel_friends, "Gender")
+#' node_diversity(marvel_friends, "Attractive")
+#' @export
+node_diversity <- function(object, attribute){
+  out <- vapply(igraph::ego(as_igraph(object)),
+                function(x) network_diversity(
+                  igraph::induced_subgraph(as_igraph(object), x),
+                  attribute),
+                FUN.VALUE = numeric(1))
+  make_node_measure(out, object)
+}
+
+#' @describeIn diversity Calculates how embedded nodes in the network
+#'    are within groups of nodes with the same attribute
 #' @section network_homophily:
 #'   Given a partition of a network into a number of mutually exclusive groups then 
 #'   The E-I index is the number of ties between (or _external_) nodes 
@@ -91,6 +106,21 @@ network_homophily <- function(object, attribute){
   make_network_measure(ei, object)
 }
 
+#' @describeIn diversity Calculates each node's embeddedness within groups
+#'    of nodes with the same attribute
+#' @examples 
+#' node_homophily(marvel_friends, "Gender")
+#' node_homophily(marvel_friends, "Attractive")
+#' @export
+node_homophily <- function(object, attribute){
+  out <- vapply(igraph::ego(as_igraph(object)),
+         function(x) network_homophily(
+           igraph::induced_subgraph(as_igraph(object), x),
+           attribute),
+         FUN.VALUE = numeric(1))
+  make_node_measure(out, object)
+}
+
 #' @describeIn diversity Calculates the degree assortativity in a graph.
 #' @importFrom igraph assortativity_degree
 #' @examples 

R/measure_features.R

@@ -74,37 +74,85 @@ network_modularity <- function(object,
 #'    Small-world networks can be highly clustered and yet
 #'    have short path lengths.
 #' @param times Integer of number of simulations.
+#' @param method There are three small-world measures implemented:
+#'   - "sigma" is the original equation from Watts and Strogatz (1998),
+#'     \deqn{\frac{\frac{C}{C_r}}{\frac{L}{L_r}}}, 
+#'     where \eqn{C} and \eqn{L} are the observed 
+#'     clustering coefficient and path length, respectively,
+#'     and \eqn{C_r} and \eqn{L_r} are the averages obtained from
+#'     random networks of the same dimensions and density.
+#'     A \eqn{\sigma > 1} is considered to be small-world,
+#'     but this measure is highly sensitive to network size.
+#'  -  "omega" (the default) is an update from Telesford et al. (2011),
+#'     \deqn{\frac{L_r}{L} - \frac{C}{C_l}},
+#'     where \eqn{C_l} is the clustering coefficient for a lattice graph
+#'     with the same dimensions.
+#'     \eqn{\omega} ranges between 0 and 1, 
+#'     where 1 is as close to a small-world as possible.
+#'  -  "SWI" is an alternative proposed by Neal (2017),
+#'     \deqn{\frac{L - L_l}{L_r - L_l} \times \frac{C - C_r}{C_l - C_r}},
+#'     where \eqn{L_l} is the average path length for a lattice graph
+#'     with the same dimensions.
+#'     \eqn{SWI} also ranges between 0 and 1 with the same interpretation, 
+#'     but where there may not be a network for which \eqn{SWI = 1}.
 #' @examples
 #' network_smallworld(ison_brandes)
 #' network_smallworld(ison_southern_women)
 #' @seealso [network_transitivity()] and [network_equivalency()]
 #'   for how clustering is calculated
 #' @references 
 #' Watts, Duncan J., and Steven H. Strogatz. 1998. 
-#' “Collective Dynamics of ‘Small-World’ Networks.” 
-#' _Nature_ 393(6684):440–42.
-#' \doi{10.1038/30918}.
+#'   “Collective Dynamics of ‘Small-World’ Networks.” 
+#'   _Nature_ 393(6684):440–42.
+#'   \doi{10.1038/30918}.
+#' 
+#' Telesford QK, Joyce KE, Hayasaka S, Burdette JH, Laurienti PJ. 2011. 
+#'   "The ubiquity of small-world networks". 
+#'   _Brain Connectivity_ 1(5): 367–75.
+#'   \doi{10.1089/brain.2011.0038}.
+#'   
+#' Neal Zachary P. 2017. 
+#'   "How small is it? Comparing indices of small worldliness". 
+#'   _Network Science_. 5 (1): 30–44.
+#'   \doi{10.1017/nws.2017.5}.
 #' @export
-network_smallworld <- function(object, times = 100) {
+network_smallworld <- function(object, 
+                               method = c("omega", "sigma", "SWI"),
+                               times = 100) {
+
+  method <- match.arg(method)
 
   if(is_twomode(object)){
-    obsclust <- network_equivalency(object)
-    expclust <- mean(vapply(1:times, 
-                            function(x) network_equivalency(generate_random(object)),
-                            FUN.VALUE = numeric(1)))
+    co <- network_equivalency(object)
+    cr <- mean(vapply(1:times, 
+                      function(x) network_equivalency(generate_random(object)),
+                      FUN.VALUE = numeric(1)))
+    if(method %in% c("omega", "SWI")){
+      cl <- network_equivalency(create_ring(object))
+    }
   } else {
-    obsclust <- network_transitivity(object)
-    expclust <- mean(vapply(1:times, 
+    co <- network_transitivity(object)
+    cr <- mean(vapply(1:times, 
                             function(x) network_transitivity(generate_random(object)),
                             FUN.VALUE = numeric(1)))
+    if(method %in% c("omega", "SWI")){
+      cl <- network_transitivity(create_lattice(object))
+    }
   }
 
-  obspath <- network_length(object)
-  exppath <- mean(vapply(1:times, 
+  lo <- network_length(object)
+  lr <- mean(vapply(1:times, 
                          function(x) network_length(generate_random(object)),
                          FUN.VALUE = numeric(1)))
+  if(method == "SWI"){
+    ll <- network_length(create_ring(object))
+  }
 
-  make_network_measure((obsclust/expclust)/(obspath/exppath),
+  out <- switch(method,
+                "omega" = (lr/lo - co/cl),
+                "sigma" = (co/cr)/(lo/lr),
+                "SWI" = ((lo - ll)/(lr - ll))*((co - cr)/(cl - cr)))
+  make_network_measure(out,
                      object)
 }