1 ;;;-*- Mode: Lisp; Package: metabang.graph -*-
5 $Id: graph-metrics.lisp,v 1.9 2005/08/09 01:56:47 gwking Exp $
12 (in-package #:metabang.graph)
15 (import '(cl-mathstats:matrix-trace
16 cl-mathstats:sum-of-array-elements
17 cl-mathstats:matrix-multiply
18 cl-mathstats:normalize-matrix
19 cl-mathstats:combination-count
22 (defun vertex-degree-counts (g)
23 "Returns an associative-container mapping edge-counts to the number of vertexes with that edge-count."
24 (let ((c (make-container 'associative-container :initial-element 0)))
28 (incf (item-at c (edge-count v)))))
31 ;;; ---------------------------------------------------------------------------
33 (defun average-vertex-degree (graph &key
34 (vertex-filter (constantly t))
35 (edge-filter (constantly t))
36 (edge-size (constantly 1)))
37 "Returns the average degree of the all of the vertexes in `graph` that pass the `vertex-filter`. Both `vertex-filter` and `edge-filter` are predicates; `edge-size` is a function that maps edges to their weight. Compare with `vertex-degree`."
43 (when (funcall vertex-filter v)
45 (incf total (%vertex-degree v edge-filter edge-size)))))
47 (values (float (/ total size)))
50 ;;; ---------------------------------------------------------------------------
52 (defun vertex-degree (vertex &key
53 (edge-filter (constantly t))
54 (edge-size (constantly 1)))
55 "Returns the degree of `vertex`. The degree is computed by totaling the `edge-size` \(e.g., the `weight`\) of each edge attached to vertex that passes `edge-filter`. `Edge-filter is a predicate and `edge-size` should map edges to their weights."
56 (declare (inline %vertex-degree))
57 (%vertex-degree vertex edge-filter edge-size))
59 ;;; ---------------------------------------------------------------------------
61 (defun %vertex-degree (vertex edge-filter edge-size)
62 "Called internally by `vertex-degree` and `average-vertex-degree`."
67 (when (funcall edge-filter e (other-vertex e vertex))
68 (incf degree (funcall edge-size e)))))
71 ;;; ---------------------------------------------------------------------------
73 (defun vertex-degree-summary (graph vertex-classifier
74 &key (edge-size (constantly 1)))
75 "Prints a summary of vertex degrees in `graph` to standard-out. Both the average degree of all vertexes and the average degree between all pairs of vertex classes \(as determined by the vertex-classifier\) will be printed. The `edge-size` parameter is passed on to `vertex-degree` to allow for weighted edges."
77 (bind ((counts (node-counts graph :key vertex-classifier))
78 (kinds (collect-elements counts :transform #'first)))
79 (format t "~%Vertex counts: ")
80 (loop for (kind count) in counts do
81 (format t "~A = ~A; " kind count))
82 (flet ((show-avd (vertex-filter edge-filter message &rest args)
84 (apply #'format t message args)
86 (average-vertex-degree
88 :vertex-filter (or vertex-filter (constantly t))
89 :edge-filter (or edge-filter (constantly t))
90 :edge-size edge-size))))
91 (show-avd nil nil "Average vertex degree:")
92 (loop for kind in kinds do
93 (show-avd (lambda (v) (equal kind (funcall vertex-classifier v))) nil
94 "Average vertex degree for ~A:" kind))
98 (lambda (v) (equal (funcall vertex-classifier v) k-1))
101 (equal (funcall vertex-classifier v) k-2))
102 "Average vertex degree between ~A and ~A:"
105 ;;; ---------------------------------------------------------------------------
108 Transitivity or Clustering.
109 the friend of your friend is likely also to be your friend.
111 C = 3 x number of triangles in the network /
112 number of connected triples of vertices
116 C = 6 x number of triangles in the network /
117 number of paths of length two
119 C measures the fraction of triples that have their third edge *filled in
120 to complete the triangle.
122 The definition of C given here has been widely used in the sociology literature,
123 where it is referred to as the fraction of transitive triples.
125 An alternative definition of the clustering coefficient, also widely used, has been given by Watts and Strogatz [415], who proposed de*ning a local value
127 Ci = number of triangles connected to vertex i /
128 number of triples centered on vertex i
130 For vertices with degree 0 or 1, for which both numerator and denominator are zero,
135 It tends to weight the contributions of
136 low-degree vertices more heavily, because such vertices have a small denominator in (3.5) and hence can give quite di*erent results from (3.3).
138 The local clustering Ci above has been used quite widely in its own right in
139 the sociological literature, where it is referred to as the network density
142 (defun average-vertex-clustering-coefficient (graph)
143 "Returns the average `vertex-clustering-coefficient` of all the vertexes in the graph."
147 graph (lambda (v) (incf total (vertex-clustering-coefficient v))))
151 ;;; ---------------------------------------------------------------------------
153 (defun vertex-clustering-coefficient (vertex)
154 "The vertex-clustering-coefficient is, informally, a measure of the number of triangles in which a vertex participates as compared to the maximum possible number of triangles in which it could participate. It measures how likely it is that any two neighbors of the vertex are also joined by an edge."
155 (if (< (edge-count vertex) 2)
157 (float (/ (vertex-triangle-count vertex)
158 (combination-count (edge-count vertex) 2)))))
160 ;;; ---------------------------------------------------------------------------
162 (defun vertex-triangle-count (vertex)
163 (let ((neighbors (neighbor-vertexes vertex)))
164 (loop for neighbor in neighbors sum
165 (/ (count-if (lambda (v)
166 (member v neighbors))
167 (neighbor-vertexes neighbor)) 2))))
169 ;;; ---------------------------------------------------------------------------
171 (defun row-sums (matrix)
172 (let* ((row-count (array-dimension matrix 1))
173 (result (make-array row-count :initial-element 0d0)))
174 (dotimes (row row-count)
175 (dotimes (column (array-dimension matrix 0))
176 (incf (aref result row) (aref matrix column row))))
179 ;;; ---------------------------------------------------------------------------
181 (defun column-sums (matrix)
182 (let* ((column-count (array-dimension matrix 0))
183 (result (make-array column-count :initial-element 0d0)))
184 (dotimes (column column-count)
185 (dotimes (row (array-dimension matrix 1))
186 (incf (aref result column) (aref matrix column row))))
189 ;;; ---------------------------------------------------------------------------
191 (defmethod assortativity-coefficient ((matrix array))
193 (let* ((matrix (normalize-matrix matrix))
194 (sum-squared (sum-of-array-elements (matrix-multiply matrix matrix)))
195 (trace (matrix-trace matrix)))
198 (values (/ (- trace sum-squared) (- 1 sum-squared))))))
200 ;;; ---------------------------------------------------------------------------
202 (defmethod graph-edge-mixture-matrix ((graph basic-graph) vertex-classifier &key
203 (edge-weight (constantly 1)))
204 (let* ((vertex-types (remove-duplicates
205 (collect-items graph :transform vertex-classifier)))
206 (size (size vertex-types))
207 (matrix (make-array (list size size) :initial-element 0d0)))
211 (let* ((vertex-class-1 (funcall vertex-classifier (vertex-1 e)))
212 (vertex-class-2 (funcall vertex-classifier (vertex-2 e)))
213 (index-1 (position vertex-class-1 vertex-types))
214 (index-2 (position vertex-class-2 vertex-types))
215 (weight (funcall edge-weight e)))
216 (incf (aref matrix index-1 index-2) weight)
217 (incf (aref matrix index-2 index-1) weight))))
219 (matrix-multiply matrix (/ (sum-of-array-elements matrix)))
223 (assortativity-coefficient
224 #2A((0.258 0.016 0.035 0.013)
225 (0.012 0.157 0.058 0.019)
226 (0.013 0.023 0.306 0.035)
227 (0.005 0.007 0.024 0.016)))
229 ;;; ---------------------------------------------------------------------------
231 ;;OPT we call the classifier a lot, probably better to make a new ht for that
233 (defmethod graph-mixing-matrix ((graph basic-graph) vertex-classifier &key
234 (edge-weight (constantly 1)))
235 (declare (ignore edge-weight))
236 (let* ((vertex-types (remove-duplicates
237 (collect-items graph :transform vertex-classifier)))
238 (size (size vertex-types))
239 (matrix (make-array (list size size) :initial-element 0d0))
240 (class-sizes (make-container 'simple-associative-container
243 (class-indexes (make-container 'simple-associative-container
246 (block determine-class-indexes
251 (let ((vertex-class (funcall vertex-classifier v)))
252 (unless (item-at-1 class-indexes vertex-class)
253 (setf (item-at-1 class-indexes vertex-class) (incf n))
254 (when (= n (1- size))
255 (return-from determine-class-indexes nil))))))))
260 (incf (item-at-1 class-sizes (funcall vertex-classifier v)))))
265 (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
269 (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
270 (incf (item-at matrix index-1 index-2))))))))
275 (lambda (class-1 index-1)
278 (lambda (class-2 index-2)
279 (setf (item-at matrix index-1 index-2)
280 (/ (item-at matrix index-1 index-2)
281 (if (= index-1 index-2)
282 (* 2 (combination-count (item-at-1 class-sizes class-1) 2))
283 (combination-count (+ (item-at-1 class-sizes class-1)
284 (item-at-1 class-sizes class-2))
287 (values matrix (collect-key-value class-indexes)
288 (collect-key-value class-sizes))))
291 ;; this computes the same matrix but is probably slower and more consy
293 (let ((vertex-classes
300 :key (lambda (v) (aref (symbol-name (element v)) 0)))))
301 (loop for (class vertexes) in vertex-classes collect
304 (loop for vertex in vertexes append
305 (neighbor-vertexes vertex))
306 :key (lambda (v) (aref (symbol-name (element v)) 0)))))))
309 (defmethod graph-mixing-matrix ((graph basic-graph) vertex-classifier &key
310 (edge-weight (constantly 1)))
311 (let* ((vertex-types (remove-duplicates
312 (collect-items graph :transform vertex-classifier)))
313 (size (size vertex-types))
314 (matrix (make-array (list size size) :initial-element 0d0))
315 (class-sizes (make-container 'simple-associative-container
318 (class-indexes (make-container 'simple-associative-container
321 (block determine-class-indexes
326 (let ((vertex-class (funcall vertex-classifier v)))
327 (unless (item-at-1 class-indexes vertex-class)
328 (setf (item-at-1 class-indexes vertex-class) (incf n))
329 (when (= n (1- size))
330 (return-from determine-class-indexes nil))))))))
335 (incf (item-at-1 class-sizes
336 (item-at-1 class-indexes (funcall vertex-classifier v))))))
341 (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
345 (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
346 ; (when (= index-1 1 index-2)
348 ; (when (< index-2 index-1)
349 ; (rotatef index-1 index-2))
350 (unless (< index-2 index-1)
351 (incf (item-at matrix index-1 index-2)))))))))
355 (lambda (class-1 index-1)
358 (lambda (class-2 index-2)
359 (when (<= index-1 index-2)
360 (setf (item-at matrix index-1 index-2)
361 (/ (item-at matrix index-1 index-2)
362 (if (= index-1 index-2)
363 (* 2 (combination-count (item-at-1 class-sizes class-1) 2))
364 (/ (combination-count (+ (item-at-1 class-sizes class-1)
365 (item-at-1 class-sizes class-2))
368 (values matrix (collect-key-value class-indexes))))