dev/graph-metrics.lisp

   1 ;;;-*- Mode: Lisp; Package: metabang.graph -*-
   2
   3 #| simple-header
   4
   5 $Id: graph-metrics.lisp,v 1.9 2005/08/09 01:56:47 gwking Exp $
   6
   7 Author: Gary King
   8
   9 DISCUSSION
  10
  11 |#
  12 (in-package #:metabang.graph)
  13
  14 (eval-always
  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
  20             )))
  21
  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)))
  25     (iterate-vertexes
  26      g
  27      (lambda (v)
  28        (incf (item-at c (edge-count v)))))
  29     c))
  30
  31 ;;; ---------------------------------------------------------------------------
  32
  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`."
  38   (let ((total 0)
  39         (size 0))
  40     (iterate-container
  41      graph
  42      (lambda (v)
  43        (when (funcall vertex-filter v)
  44          (incf size)
  45          (incf total (%vertex-degree v edge-filter edge-size)))))
  46     (if size
  47       (values (float (/ total size)))
  48       nil)))
  49
  50 ;;; ---------------------------------------------------------------------------
  51
  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))
  58
  59 ;;; ---------------------------------------------------------------------------
  60
  61 (defun %vertex-degree (vertex edge-filter edge-size)
  62   "Called internally by `vertex-degree` and `average-vertex-degree`."
  63   (let ((degree 0))
  64     (iterate-edges
  65      vertex
  66      (lambda (e)
  67        (when (funcall edge-filter e (other-vertex e vertex))
  68          (incf degree (funcall edge-size e)))))
  69     degree))
  70
  71 ;;; ---------------------------------------------------------------------------
  72
  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."
  76
  77   (let ((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)
  83              (terpri)
  84              (apply #'format t message args)
  85              (format t "~7,2F"
  86                      (average-vertex-degree
  87                       graph
  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))
  95       (dolist (k-1 kinds)
  96         (dolist (k-2 kinds)
  97           (show-avd
  98            (lambda (v) (equal (funcall vertex-classifier v) k-1))
  99            (lambda (e v)
 100              (declare (ignore e))
 101              (equal (funcall vertex-classifier v) k-2))
 102            "Average vertex degree between ~A and ~A:"
 103            k-1 k-2))))))
 104
 105 ;;; ---------------------------------------------------------------------------
 106
 107 #|
 108 Transitivity or Clustering.
 109 the friend of your friend is likely also to be your friend.
 110
 111 C = 3 x number of triangles in the network /
 112     number of connected triples of vertices
 113
 114 or
 115
 116 C = 6 x number of triangles in the network /
 117     number of paths of length two
 118
 119 C measures the fraction of triples that have their third edge *filled in
 120 to complete the triangle.
 121
 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.
 124
 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
 126
 127 Ci = number of triangles connected to vertex i /
 128      number of triples centered on vertex i
 129
 130 For vertices with degree 0 or 1, for which both numerator and denominator are zero,
 131 we put Ci = 0.
 132
 133 C = Sum( Ci ) / n
 134
 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).
 137
 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
 140 |#
 141
 142 (defun average-vertex-clustering-coefficient (graph)
 143   "Returns the average `vertex-clustering-coefficient` of all the vertexes in the graph."
 144   (/
 145    (let ((total 0.0))
 146      (iterate-vertexes
 147       graph (lambda (v) (incf total (vertex-clustering-coefficient v))))
 148      total)
 149    (size graph)))
 150
 151 ;;; ---------------------------------------------------------------------------
 152
 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)
 156     0.0
 157     (float (/ (vertex-triangle-count vertex)
 158               (combination-count (edge-count vertex) 2)))))
 159
 160 ;;; ---------------------------------------------------------------------------
 161
 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))))
 168
 169 ;;; ---------------------------------------------------------------------------
 170
 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))))
 177     result))
 178
 179 ;;; ---------------------------------------------------------------------------
 180
 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))))
 187     result))
 188
 189 ;;; ---------------------------------------------------------------------------
 190
 191 (defmethod assortativity-coefficient ((matrix array))
 192
 193   (let* ((matrix (normalize-matrix matrix))
 194          (sum-squared (sum-of-array-elements (matrix-multiply matrix matrix)))
 195          (trace (matrix-trace matrix)))
 196     (if (= trace 1d0)
 197       (values 1)
 198       (values (/ (- trace sum-squared) (- 1 sum-squared))))))
 199
 200 ;;; ---------------------------------------------------------------------------
 201
 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)))
 208     (iterate-edges
 209      graph
 210      (lambda (e)
 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))))
 218     (values
 219      (matrix-multiply matrix (/ (sum-of-array-elements matrix)))
 220      vertex-types)))
 221
 222 #+Test
 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)))
 228
 229 ;;; ---------------------------------------------------------------------------
 230
 231 ;;OPT we call the classifier a lot, probably better to make a new ht for that
 232
 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
 241                                       :initial-element 0
 242                                       :test #'eq))
 243          (class-indexes (make-container 'simple-associative-container
 244                                         :initial-element nil
 245                                         :test #'eq)))
 246     (block determine-class-indexes
 247       (let ((n -1))
 248         (iterate-vertexes
 249          graph
 250          (lambda (v)
 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))))))))
 256
 257     (iterate-vertexes
 258      graph
 259      (lambda (v)
 260        (incf (item-at-1 class-sizes (funcall vertex-classifier v)))))
 261
 262     (iterate-vertexes
 263      graph
 264      (lambda (v-1)
 265        (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
 266          (iterate-neighbors
 267           v-1
 268           (lambda (v-2)
 269             (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
 270               (incf (item-at matrix index-1 index-2))))))))
 271
 272     #+Ignore
 273     (iterate-key-value
 274      class-indexes
 275      (lambda (class-1 index-1)
 276        (iterate-key-value
 277         class-indexes
 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))
 285                                         2))))))))
 286
 287     (values matrix (collect-key-value class-indexes)
 288             (collect-key-value class-sizes))))
 289
 290 #+Test
 291 ;; this computes the same matrix but is probably slower and more consy
 292 (time
 293  (let ((vertex-classes
 294         (merge-nodes
 295          (adma::ds :g-5000)
 296          (lambda (old new)
 297            (push new old))
 298          (lambda (first)
 299            (list first))
 300          :key (lambda (v) (aref (symbol-name (element v)) 0)))))
 301    (loop for (class vertexes) in vertex-classes collect
 302          (list class
 303                (element-counts
 304                 (loop for vertex in vertexes append
 305                       (neighbor-vertexes vertex))
 306                 :key (lambda (v) (aref (symbol-name (element v)) 0)))))))
 307
 308 #+Old
 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
 316                                       :initial-element 0
 317                                       :test #'eq))
 318          (class-indexes (make-container 'simple-associative-container
 319                                         :initial-element nil
 320                                         :test #'eq)))
 321     (block determine-class-indexes
 322       (let ((n -1))
 323         (iterate-vertexes
 324          graph
 325          (lambda (v)
 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))))))))
 331
 332     (iterate-vertexes
 333      graph
 334      (lambda (v)
 335        (incf (item-at-1 class-sizes
 336                         (item-at-1 class-indexes (funcall vertex-classifier v))))))
 337
 338     (iterate-vertexes
 339      graph
 340      (lambda (v-1)
 341        (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
 342          (iterate-neighbors
 343           v-1
 344           (lambda (v-2)
 345             (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
 346               ;  (when (= index-1 1 index-2)
 347               ;    (break))
 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)))))))))
 352
 353     (iterate-key-value
 354      class-indexes
 355      (lambda (class-1 index-1)
 356        (iterate-key-value
 357         class-indexes
 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))
 366                                              2) 2)))))))))
 367
 368     (values matrix (collect-key-value class-indexes))))
 369
 370
 371
 372
 373
 374
 375