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 (defun vertex-degree-counts (g)
16 "Returns an associative-container mapping edge-counts to the number of vertexes with that edge-count."
17 (let ((c (make-container 'associative-container :initial-element 0)))
21 (incf (item-at c (edge-count v)))))
24 ;;; ---------------------------------------------------------------------------
26 (defun average-vertex-degree (graph &key
27 (vertex-filter (constantly t))
28 (edge-filter (constantly t))
29 (edge-size (constantly 1)))
30 "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`."
36 (when (funcall vertex-filter v)
38 (incf total (%vertex-degree v edge-filter edge-size)))))
40 (values (float (/ total size)))
43 ;;; ---------------------------------------------------------------------------
45 (defun vertex-degree (vertex &key
46 (edge-filter (constantly t))
47 (edge-size (constantly 1)))
48 "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."
49 (declare (inline %vertex-degree))
50 (%vertex-degree vertex edge-filter edge-size))
52 ;;; ---------------------------------------------------------------------------
54 (defun %vertex-degree (vertex edge-filter edge-size)
55 "Called internally by `vertex-degree` and `average-vertex-degree`."
60 (when (funcall edge-filter e (other-vertex e vertex))
61 (incf degree (funcall edge-size e)))))
64 ;;; ---------------------------------------------------------------------------
66 (defun vertex-degree-summary (graph vertex-classifier
67 &key (edge-size (constantly 1)))
68 "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."
70 (bind ((counts (node-counts graph :key vertex-classifier))
71 (kinds (collect-elements counts :transform #'first)))
72 (format t "~%Vertex counts: ")
73 (loop for (kind count) in counts do
74 (format t "~A = ~A; " kind count))
75 (flet ((show-avd (vertex-filter edge-filter message &rest args)
77 (apply #'format t message args)
79 (average-vertex-degree
81 :vertex-filter (or vertex-filter (constantly t))
82 :edge-filter (or edge-filter (constantly t))
83 :edge-size edge-size))))
84 (show-avd nil nil "Average vertex degree:")
85 (loop for kind in kinds do
86 (show-avd (lambda (v) (equal kind (funcall vertex-classifier v))) nil
87 "Average vertex degree for ~A:" kind))
91 (lambda (v) (equal (funcall vertex-classifier v) k-1))
94 (equal (funcall vertex-classifier v) k-2))
95 "Average vertex degree between ~A and ~A:"
98 ;;; ---------------------------------------------------------------------------
101 Transitivity or Clustering.
102 the friend of your friend is likely also to be your friend.
104 C = 3 x number of triangles in the network /
105 number of connected triples of vertices
109 C = 6 x number of triangles in the network /
110 number of paths of length two
112 C measures the fraction of triples that have their third edge *filled in
113 to complete the triangle.
115 The definition of C given here has been widely used in the sociology literature,
116 where it is referred to as the fraction of transitive triples.
118 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
120 Ci = number of triangles connected to vertex i /
121 number of triples centered on vertex i
123 For vertices with degree 0 or 1, for which both numerator and denominator are zero,
128 It tends to weight the contributions of
129 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).
131 The local clustering Ci above has been used quite widely in its own right in
132 the sociological literature, where it is referred to as the network density
135 (defun average-vertex-clustering-coefficient (graph)
136 "Returns the average `vertex-clustering-coefficient` of all the vertexes in the graph."
140 graph (lambda (v) (incf total (vertex-clustering-coefficient v))))
144 ;;; ---------------------------------------------------------------------------
146 (defun vertex-clustering-coefficient (vertex)
147 "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."
148 (if (< (edge-count vertex) 2)
150 (float (/ (vertex-triangle-count vertex)
151 (combination-count (edge-count vertex) 2)))))
153 ;;; ---------------------------------------------------------------------------
155 (defun vertex-triangle-count (vertex)
156 (let ((neighbors (neighbor-vertexes vertex)))
157 (loop for neighbor in neighbors sum
158 (/ (count-if (lambda (v)
159 (member v neighbors))
160 (neighbor-vertexes neighbor)) 2))))
162 ;;; ---------------------------------------------------------------------------
164 (defun row-sums (matrix)
165 (let* ((row-count (array-dimension matrix 1))
166 (result (make-array row-count :initial-element 0d0)))
167 (dotimes (row row-count)
168 (dotimes (column (array-dimension matrix 0))
169 (incf (aref result row) (aref matrix column row))))
172 ;;; ---------------------------------------------------------------------------
174 (defun column-sums (matrix)
175 (let* ((column-count (array-dimension matrix 0))
176 (result (make-array column-count :initial-element 0d0)))
177 (dotimes (column column-count)
178 (dotimes (row (array-dimension matrix 1))
179 (incf (aref result column) (aref matrix column row))))
182 ;;; ---------------------------------------------------------------------------
184 (defmethod assortativity-coefficient ((matrix array))
186 (let* ((matrix (normalize-matrix matrix))
187 (sum-squared (sum-of-array-elements (matrix-multiply matrix matrix)))
188 (trace (matrix-trace matrix)))
191 (values (/ (- trace sum-squared) (- 1 sum-squared))))))
193 ;;; ---------------------------------------------------------------------------
195 (defmethod graph-edge-mixture-matrix ((graph basic-graph) vertex-classifier &key
196 (edge-weight (constantly 1)))
197 (let* ((vertex-types (remove-duplicates
198 (collect-items graph :transform vertex-classifier)))
199 (size (size vertex-types))
200 (matrix (make-array (list size size) :initial-element 0d0)))
204 (let* ((vertex-class-1 (funcall vertex-classifier (vertex-1 e)))
205 (vertex-class-2 (funcall vertex-classifier (vertex-2 e)))
206 (index-1 (position vertex-class-1 vertex-types))
207 (index-2 (position vertex-class-2 vertex-types))
208 (weight (funcall edge-weight e)))
209 (incf (aref matrix index-1 index-2) weight)
210 (incf (aref matrix index-2 index-1) weight))))
212 (matrix-multiply matrix (/ (sum-of-array-elements matrix)))
216 (assortativity-coefficient
217 #2A((0.258 0.016 0.035 0.013)
218 (0.012 0.157 0.058 0.019)
219 (0.013 0.023 0.306 0.035)
220 (0.005 0.007 0.024 0.016)))
222 ;;; ---------------------------------------------------------------------------
224 ;;OPT we call the classifier a lot, probably better to make a new ht for that
226 (defmethod graph-mixing-matrix ((graph basic-graph) vertex-classifier &key
227 (edge-weight (constantly 1)))
228 (declare (ignore edge-weight))
229 (let* ((vertex-types (remove-duplicates
230 (collect-items graph :transform vertex-classifier)))
231 (size (size vertex-types))
232 (matrix (make-array (list size size) :initial-element 0d0))
233 (class-sizes (make-container 'simple-associative-container
236 (class-indexes (make-container 'simple-associative-container
239 (block determine-class-indexes
244 (let ((vertex-class (funcall vertex-classifier v)))
245 (unless (item-at-1 class-indexes vertex-class)
246 (setf (item-at-1 class-indexes vertex-class) (incf n))
247 (when (= n (1- size))
248 (return-from determine-class-indexes nil))))))))
253 (incf (item-at-1 class-sizes (funcall vertex-classifier v)))))
258 (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
262 (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
263 (incf (item-at matrix index-1 index-2))))))))
268 (lambda (class-1 index-1)
271 (lambda (class-2 index-2)
272 (setf (item-at matrix index-1 index-2)
273 (/ (item-at matrix index-1 index-2)
274 (if (= index-1 index-2)
275 (* 2 (combination-count (item-at-1 class-sizes class-1) 2))
276 (combination-count (+ (item-at-1 class-sizes class-1)
277 (item-at-1 class-sizes class-2))
280 (values matrix (collect-key-value class-indexes)
281 (collect-key-value class-sizes))))
284 ;; this computes the same matrix but is probably slower and more consy
286 (let ((vertex-classes
293 :key (lambda (v) (aref (symbol-name (element v)) 0)))))
294 (loop for (class vertexes) in vertex-classes collect
297 (loop for vertex in vertexes append
298 (neighbor-vertexes vertex))
299 :key (lambda (v) (aref (symbol-name (element v)) 0)))))))
302 (defmethod graph-mixing-matrix ((graph basic-graph) vertex-classifier &key
303 (edge-weight (constantly 1)))
304 (let* ((vertex-types (remove-duplicates
305 (collect-items graph :transform vertex-classifier)))
306 (size (size vertex-types))
307 (matrix (make-array (list size size) :initial-element 0d0))
308 (class-sizes (make-container 'simple-associative-container
311 (class-indexes (make-container 'simple-associative-container
314 (block determine-class-indexes
319 (let ((vertex-class (funcall vertex-classifier v)))
320 (unless (item-at-1 class-indexes vertex-class)
321 (setf (item-at-1 class-indexes vertex-class) (incf n))
322 (when (= n (1- size))
323 (return-from determine-class-indexes nil))))))))
328 (incf (item-at-1 class-sizes
329 (item-at-1 class-indexes (funcall vertex-classifier v))))))
334 (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
338 (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
339 ; (when (= index-1 1 index-2)
341 ; (when (< index-2 index-1)
342 ; (rotatef index-1 index-2))
343 (unless (< index-2 index-1)
344 (incf (item-at matrix index-1 index-2)))))))))
348 (lambda (class-1 index-1)
351 (lambda (class-2 index-2)
352 (when (<= index-1 index-2)
353 (setf (item-at matrix index-1 index-2)
354 (/ (item-at matrix index-1 index-2)
355 (if (= index-1 index-2)
356 (* 2 (combination-count (item-at-1 class-sizes class-1) 2))
357 (/ (combination-count (+ (item-at-1 class-sizes class-1)
358 (item-at-1 class-sizes class-2))
361 (values matrix (collect-key-value class-indexes))))