Merge pull request #282 from snlab-ch/develop

v 1.1.7

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: migraph
 Title: Multimodal Network Analysis and More
-Version: 1.1.6
-Date: 2023-11-08
+Version: 1.1.7
+Date: 2023-11-15
 Description: A set of tools for analysing multimodal networks.
    It includes functions for measuring 
    centrality, centralization, cohesion, closure, constraint and diversity,

NAMESPACE

@@ -125,20 +125,25 @@ export(network_harmonic)
 export(network_heterophily)
 export(network_homophily)
 export(network_indegree)
+export(network_infection_length)
 export(network_length)
 export(network_mixed_census)
 export(network_modularity)
 export(network_outdegree)
 export(network_reach)
 export(network_reciprocity)
 export(network_reg)
+export(network_reproduction)
 export(network_richclub)
 export(network_richness)
 export(network_scalefree)
 export(network_smallworld)
 export(network_transitivity)
+export(network_transmissibility)
 export(network_triad_census)
 export(network_upperbound)
+export(node_adopter)
+export(node_adoption_time)
 export(node_alpha)
 export(node_automorphic_equivalence)
 export(node_betweenness)
@@ -164,11 +169,13 @@ export(node_heterophily)
 export(node_hierarchy)
 export(node_homophily)
 export(node_indegree)
+export(node_infection_length)
 export(node_infomap)
 export(node_is_core)
 export(node_is_cutpoint)
 export(node_is_isolate)
 export(node_is_max)
+export(node_is_mentor)
 export(node_is_min)
 export(node_is_random)
 export(node_kernighanlin)
@@ -190,6 +197,7 @@ export(node_richness)
 export(node_spinglass)
 export(node_strong_components)
 export(node_structural_equivalence)
+export(node_thresholds)
 export(node_tie_census)
 export(node_transitivity)
 export(node_triad_census)

NEWS.md

@@ -1,3 +1,29 @@
+# migraph 1.1.7
+
+2023-11-15
+
+## Package
+
+- Added diffusion measures to website.
+
+## Measures
+
+- Fixed documentation issues for diffusion measures.
+
+## Marks
+
+- Added `node_is_mentor()` for indicating nodes with high indegree.
+
+## Models
+
+- Added 'minimising' distance option for segregation model choice.
+- Changed 'satisficing' option in `play_segregation()` to sample randomly from
+those unoccupied options less than the desired threshold.
+
+## Tutorials
+
+- Added multi-choice questions to tutorial 8.
+
 # migraph 1.1.6
 
 2023-11-08

R/mark_nodes.R

@@ -76,6 +76,35 @@ node_is_random <- function(.data, size = 1){
   make_node_mark(out, .data)
 }
 
+#' @describeIn mark_nodes Returns a logical vector
+#'   indicating mentor (high indegree) nodes as TRUE.
+#' @param elites The proportion of nodes to be selected as mentors.
+#'   By default this is set at 0.1.
+#'   This means that the top 10% of nodes in terms of degree,
+#'   or those equal to the highest rank degree in the network,
+#'   whichever is the higher, will be used to select the mentors.
+#'   
+#'   Note that if nodes are equidistant from two mentors,
+#'   they will choose one at random.
+#'   If a node is without a path to a mentor,
+#'   for example because they are an isolate,
+#'   a tie to themselves (a loop) will be created instead.
+#'   Note that this is a different default behaviour than that
+#'   described in Valente and Davis (1999).
+#' @references
+#' Valente, Thomas, and Rebecca Davis. 1999.
+#' "Accelerating the Diffusion of Innovations Using Opinion Leaders",
+#' _Annals of the American Academy of Political and Social Science_ 566: 56-67.
+#' @export
+node_is_mentor <- function(.data, elites = 0.1){
+  indegs <- colSums(manynet::as_matrix(.data)) # get rank order of indegrees
+  out <- indegs == max(indegs)
+  if(sum(out) < length(indegs)*elites){
+    out <- indegs %in% unique(sort(indegs, decreasing=TRUE)[seq_len(length(indegs)*elites)])
+  }
+  make_node_mark(out, .data)
+}
+
 #' @describeIn mark_nodes Returns logical of which nodes 
 #'   hold the maximum of some measure
 #' @param node_measure An object created by a `node_` measure.

R/measure_diffusion.R

@@ -3,6 +3,9 @@
 #' @family measures
 #' @name diffusion
 #' @references
+#'   Kermack, W. and McKendrick, A., 1927. "A contribution to the mathematical theory of epidemics". 
+#'   _Proc. R. Soc. London A_ 115: 700-721.
+#'   
 #'   Valente, Tom W. (1995). _Network models of the diffusion of innovations_
 #'   (2nd ed.). Cresskill N.J.: Hampton Press.
 NULL

R/measure_features.R

@@ -72,7 +72,7 @@ network_richclub <- function(.data){
 #' @describeIn features Returns correlation between a given network
 #'   and a component model with the same dimensions.
 #'   If no 'membership' vector is given for the data, 
-#'   `node_kernaghinlin()` is used to obtain a partition into two groups.
+#'   `node_kernighanlin()` is used to obtain a partition into two groups.
 #' @examples 
 #'   network_factions(mpn_elite_mex)
 #'   network_factions(ison_southern_women)

R/measure_heterogeneity.R

@@ -154,7 +154,7 @@ node_heterophily <- function(.data, attribute){
   make_node_measure(ei, .data)
 }
 
-#' @describeIn heterogeneity Calculates the degree assortativity in a graph.
+#' @describeIn heterogeneity Calculates the degree assortativity in a network.
 #' @importFrom igraph assortativity_degree
 #' @examples 
 #' network_assortativity(mpn_elite_mex)

R/model_play.R

@@ -24,7 +24,7 @@
 #'   By default 0, which means there is no recovery (i.e. an SI model).
 #'   Anything higher results in an SIR model.
 #' @param latency The inverse probability those who have been exposed
-#'   become infectious (infected), \eqn{\sigma}.
+#'   become infectious (infected), \eqn{\sigma} or \eqn{\kappa}.
 #'   For example, if exposed individuals take, on average, 
 #'   four days to become infectious, then \eqn{\sigma = 0.75} (1/1-0.75 = 1/0.25 = 4).
 #'   By default 0, which means those exposed become immediately infectious (i.e. an SI model).
@@ -238,23 +238,24 @@ play_learning <- function(.data,
 #' @param choice_function One of the following options:
 #'   "satisficing" (the default) will move the node to any coordinates that satisfy
 #'   their heterophily threshold,
-#'   whereas "optimising" will move the node to coordinates that are most homophilous.
+#'   "optimising" will move the node to coordinates that are most homophilous,
+#'   and "minimising" distance will move the node to the next nearest unoccupied coordinates.
 #' @examples 
 #'   startValues <- rbinom(100,1,prob = 0.5)
 #'   startValues[sample(seq_len(100), round(100*0.2))] <- NA
 #'   latticeEg <- manynet::create_lattice(100)
 #'   latticeEg <- manynet::add_node_attribute(latticeEg, "startValues", startValues)
 #'   latticeEg
 #'   play_segregation(latticeEg, "startValues", 0.5)
-#'   #manynet::autographr(latticeEg, node_color = "startValues", node_size = 5)
-#'   #manynet::autographr(play_segregation(latticeEg, "startValues", 0.5), 
-#'   #                    node_color = "startValues", node_size = 5)
+#'   # manynet::autographr(latticeEg, node_color = "startValues", node_size = 5) + 
+#'   # manynet::autographr(play_segregation(latticeEg, "startValues", 0.2), 
+#'   #                     node_color = "startValues", node_size = 5)
 #' @export
 play_segregation <- function(.data, 
                              attribute,
                              heterophily = 0,
                              who_moves = c("ordered","random","most_dissatisfied"),
-                             choice_function = c("satisficing","optimising"),
+                             choice_function = c("satisficing","optimising", "minimising"),
                              steps){
   n <- manynet::network_nodes(.data)
   if(missing(steps)) steps <- n
@@ -289,8 +290,11 @@ play_segregation <- function(.data,
     }, FUN.VALUE = numeric(1))
     if(length(options)==0) next
     move_to <- switch(choice_function,
-                      satisficing = unoccupied[which(options <= heterophily)[1]],
-                      optimising = unoccupied[which(options == min(options))[1]])
+                      satisficing = unoccupied[sample(which(options <= heterophily[unoccupied]), 1)],
+                      optimising = unoccupied[which.min(options)[1]],
+                      minimising = unoccupied[which.min(igraph::distances(temp, 
+                                                                          igraph::V(temp)[dissatisfied], 
+                                                                          igraph::V(temp)[unoccupied]))])
     if(is.na(move_to)) next
     print(paste("Moving node", dissatisfied, "to node", move_to))
     temp <- manynet::add_node_attribute(temp, attribute,