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 (defun average-vertex-degree (graph &key
  33                                 (vertex-filter (constantly t))
  34                                 (edge-filter (constantly t))
  35                                 (edge-size (constantly 1)))
  36   "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`."
  37   (let ((total 0)
  38         (size 0))
  39     (iterate-container
  40      graph
  41      (lambda (v)
  42        (when (funcall vertex-filter v)
  43          (incf size)
  44          (incf total (%vertex-degree v edge-filter edge-size)))))
  45     (if size
  46       (values (float (/ total size)))
  47       nil)))
  48
  49
  50 (defun vertex-degree (vertex &key
  51                              (edge-filter (constantly t))
  52                              (edge-size (constantly 1)))
  53   "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."
  54   (declare (inline %vertex-degree))
  55   (%vertex-degree vertex edge-filter edge-size))
  56
  57
  58 (defun %vertex-degree (vertex edge-filter edge-size)
  59   "Called internally by `vertex-degree` and `average-vertex-degree`."
  60   (let ((degree 0))
  61     (iterate-edges
  62      vertex
  63      (lambda (e)
  64        (when (funcall edge-filter e (other-vertex e vertex))
  65          (incf degree (funcall edge-size e)))))
  66     degree))
  67
  68
  69 (defun vertex-degree-summary (graph vertex-classifier
  70                                     &key (edge-size (constantly 1)))
  71   "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."
  72
  73   (let ((counts (node-counts graph :key vertex-classifier))
  74          (kinds (collect-elements counts :transform #'first)))
  75     (format t "~%Vertex counts: ")
  76     (loop for (kind count) in counts do
  77           (format t "~A = ~A; " kind count))
  78     (flet ((show-avd (vertex-filter edge-filter message &rest args)
  79              (terpri)
  80              (apply #'format t message args)
  81              (format t "~7,2F"
  82                      (average-vertex-degree
  83                       graph
  84                       :vertex-filter (or vertex-filter (constantly t))
  85                       :edge-filter (or edge-filter (constantly t))
  86                       :edge-size edge-size))))
  87       (show-avd nil nil "Average vertex degree:")
  88       (loop for kind in kinds do
  89             (show-avd (lambda (v) (equal kind (funcall vertex-classifier v))) nil
  90                       "Average vertex degree for ~A:" kind))
  91       (dolist (k-1 kinds)
  92         (dolist (k-2 kinds)
  93           (show-avd
  94            (lambda (v) (equal (funcall vertex-classifier v) k-1))
  95            (lambda (e v)
  96              (declare (ignore e))
  97              (equal (funcall vertex-classifier v) k-2))
  98            "Average vertex degree between ~A and ~A:"
  99            k-1 k-2))))))
 100
 101
 102 #|
 103 Transitivity or Clustering.
 104 the friend of your friend is likely also to be your friend.
 105
 106 C = 3 x number of triangles in the network /
 107     number of connected triples of vertices
 108
 109 or
 110
 111 C = 6 x number of triangles in the network /
 112     number of paths of length two
 113
 114 C measures the fraction of triples that have their third edge *filled in
 115 to complete the triangle.
 116
 117 The definition of C given here has been widely used in the sociology literature,
 118 where it is referred to as the  fraction of transitive triples.
 119
 120 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
 121
 122 Ci = number of triangles connected to vertex i /
 123      number of triples centered on vertex i
 124
 125 For vertices with degree 0 or 1, for which both numerator and denominator are zero,
 126 we put Ci = 0.
 127
 128 C = Sum( Ci ) / n
 129
 130 It tends to weight the contributions of
 131 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).
 132
 133 The local clustering Ci above has been used quite widely in its own right in
 134 the sociological literature, where it is referred to as the network density
 135 |#
 136
 137 (defun average-vertex-clustering-coefficient (graph)
 138   "Returns the average `vertex-clustering-coefficient` of all the vertexes in the graph."
 139   (/
 140    (let ((total 0.0))
 141      (iterate-vertexes
 142       graph (lambda (v) (incf total (vertex-clustering-coefficient v))))
 143      total)
 144    (size graph)))
 145
 146 ;;; ---------------------------------------------------------------------------
 147
 148 (defun vertex-clustering-coefficient (vertex)
 149   "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."
 150   (if (< (edge-count vertex) 2)
 151     0.0
 152     (float (/ (vertex-triangle-count vertex)
 153               (combination-count (edge-count vertex) 2)))))
 154
 155
 156 (defun vertex-triangle-count (vertex)
 157   (let ((neighbors (neighbor-vertexes vertex)))
 158     (loop for neighbor in neighbors sum
 159           (/ (count-if (lambda (v)
 160                          (member v neighbors))
 161                        (neighbor-vertexes neighbor)) 2))))
 162
 163
 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))))
 170     result))
 171
 172
 173 (defun column-sums (matrix)
 174   (let* ((column-count (array-dimension matrix 0))
 175          (result (make-array column-count :initial-element 0d0)))
 176     (dotimes (column column-count)
 177       (dotimes (row (array-dimension matrix 1))
 178         (incf (aref result column) (aref matrix column row))))
 179     result))
 180
 181
 182 (defmethod assortativity-coefficient ((matrix array))
 183
 184   (let* ((matrix (normalize-matrix matrix))
 185          (sum-squared (sum-of-array-elements (matrix-multiply matrix matrix)))
 186          (trace (matrix-trace matrix)))
 187     (if (= trace 1d0)
 188       (values 1)
 189       (values (/ (- trace sum-squared) (- 1 sum-squared))))))
 190
 191
 192 (defmethod graph-edge-mixture-matrix ((graph basic-graph) vertex-classifier &key
 193                                 (edge-weight (constantly 1)))
 194   (let* ((vertex-types (remove-duplicates
 195                         (collect-items graph :transform vertex-classifier)))
 196          (size (size vertex-types))
 197          (matrix (make-array (list size size) :initial-element 0d0)))
 198     (iterate-edges
 199      graph
 200      (lambda (e)
 201        (let* ((vertex-class-1 (funcall vertex-classifier (vertex-1 e)))
 202               (vertex-class-2 (funcall vertex-classifier (vertex-2 e)))
 203               (index-1 (position vertex-class-1 vertex-types))
 204               (index-2 (position vertex-class-2 vertex-types))
 205               (weight (funcall edge-weight e)))
 206          (incf (aref matrix index-1 index-2) weight)
 207          (incf (aref matrix index-2 index-1) weight))))
 208     (values
 209      (matrix-multiply matrix (/ (sum-of-array-elements matrix)))
 210      vertex-types)))
 211
 212 #+Test
 213 (assortativity-coefficient
 214  #2A((0.258 0.016 0.035 0.013)
 215      (0.012 0.157 0.058 0.019)
 216      (0.013 0.023 0.306 0.035)
 217      (0.005 0.007 0.024 0.016)))
 218
 219
 220 ;;OPT we call the classifier a lot, probably better to make a new ht for that
 221
 222 (defmethod graph-mixing-matrix ((graph basic-graph) vertex-classifier &key
 223                                 (edge-weight (constantly 1)))
 224   (declare (ignore edge-weight))
 225   (let* ((vertex-types (remove-duplicates
 226                         (collect-items graph :transform vertex-classifier)))
 227          (size (size vertex-types))
 228          (matrix (make-array (list size size) :initial-element 0d0))
 229          (class-sizes (make-container 'simple-associative-container
 230                                       :initial-element 0
 231                                       :test #'eq))
 232          (class-indexes (make-container 'simple-associative-container
 233                                         :initial-element nil
 234                                         :test #'eq)))
 235     (block determine-class-indexes
 236       (let ((n -1))
 237         (iterate-vertexes
 238          graph
 239          (lambda (v)
 240            (let ((vertex-class (funcall vertex-classifier v)))
 241              (unless (item-at-1 class-indexes vertex-class)
 242                (setf (item-at-1 class-indexes vertex-class) (incf n))
 243                (when (= n (1- size))
 244                  (return-from determine-class-indexes nil))))))))
 245
 246     (iterate-vertexes
 247      graph
 248      (lambda (v)
 249        (incf (item-at-1 class-sizes (funcall vertex-classifier v)))))
 250
 251     (iterate-vertexes
 252      graph
 253      (lambda (v-1)
 254        (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
 255          (iterate-neighbors
 256           v-1
 257           (lambda (v-2)
 258             (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
 259               (incf (item-at matrix index-1 index-2))))))))
 260
 261     #+Ignore
 262     (iterate-key-value
 263      class-indexes
 264      (lambda (class-1 index-1)
 265        (iterate-key-value
 266         class-indexes
 267         (lambda (class-2 index-2)
 268           (setf (item-at matrix index-1 index-2)
 269                 (/ (item-at matrix index-1 index-2)
 270                    (if (= index-1 index-2)
 271                      (* 2 (combination-count (item-at-1 class-sizes class-1) 2))
 272                      (combination-count (+ (item-at-1 class-sizes class-1)
 273                                            (item-at-1 class-sizes class-2))
 274                                         2))))))))
 275
 276     (values matrix (collect-key-value class-indexes)
 277             (collect-key-value class-sizes))))
 278
 279 #+Test
 280 ;; this computes the same matrix but is probably slower and more consy
 281 (time
 282  (let ((vertex-classes
 283         (merge-nodes
 284          (adma::ds :g-5000)
 285          (lambda (old new)
 286            (push new old))
 287          (lambda (first)
 288            (list first))
 289          :key (lambda (v) (aref (symbol-name (element v)) 0)))))
 290    (loop for (class vertexes) in vertex-classes collect
 291          (list class
 292                (element-counts
 293                 (loop for vertex in vertexes append
 294                       (neighbor-vertexes vertex))
 295                 :key (lambda (v) (aref (symbol-name (element v)) 0)))))))
 296
 297 #+Old
 298 (defmethod graph-mixing-matrix ((graph basic-graph) vertex-classifier &key
 299                                 (edge-weight (constantly 1)))
 300   (let* ((vertex-types (remove-duplicates
 301                         (collect-items graph :transform vertex-classifier)))
 302          (size (size vertex-types))
 303          (matrix (make-array (list size size) :initial-element 0d0))
 304          (class-sizes (make-container 'simple-associative-container
 305                                       :initial-element 0
 306                                       :test #'eq))
 307          (class-indexes (make-container 'simple-associative-container
 308                                         :initial-element nil
 309                                         :test #'eq)))
 310     (block determine-class-indexes
 311       (let ((n -1))
 312         (iterate-vertexes
 313          graph
 314          (lambda (v)
 315            (let ((vertex-class (funcall vertex-classifier v)))
 316              (unless (item-at-1 class-indexes vertex-class)
 317                (setf (item-at-1 class-indexes vertex-class) (incf n))
 318                (when (= n (1- size))
 319                  (return-from determine-class-indexes nil))))))))
 320
 321     (iterate-vertexes
 322      graph
 323      (lambda (v)
 324        (incf (item-at-1 class-sizes
 325                         (item-at-1 class-indexes (funcall vertex-classifier v))))))
 326
 327     (iterate-vertexes
 328      graph
 329      (lambda (v-1)
 330        (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
 331          (iterate-neighbors
 332           v-1
 333           (lambda (v-2)
 334             (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
 335               ;  (when (= index-1 1 index-2)
 336               ;    (break))
 337               ;  (when (< index-2 index-1)
 338               ;    (rotatef index-1 index-2))
 339               (unless (< index-2 index-1)
 340                 (incf (item-at matrix index-1 index-2)))))))))
 341
 342     (iterate-key-value
 343      class-indexes
 344      (lambda (class-1 index-1)
 345        (iterate-key-value
 346         class-indexes
 347         (lambda (class-2 index-2)
 348           (when (<= index-1 index-2)
 349             (setf (item-at matrix index-1 index-2)
 350                   (/ (item-at matrix index-1 index-2)
 351                      (if (= index-1 index-2)
 352                        (* 2 (combination-count (item-at-1 class-sizes class-1) 2))
 353                        (/ (combination-count (+ (item-at-1 class-sizes class-1)
 354                                                 (item-at-1 class-sizes class-2))
 355                                              2) 2)))))))))
 356
 357     (values matrix (collect-key-value class-indexes))))
 358
 359
 360
 361
 362
 363
 364