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
  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)))
  18     (iterate-vertexes
  19      g
  20      (lambda (v)
  21        (incf (item-at c (edge-count v)))))
  22     c))
  23
  24 ;;; ---------------------------------------------------------------------------
  25
  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`."
  31   (let ((total 0)
  32         (size 0))
  33     (iterate-container
  34      graph
  35      (lambda (v)
  36        (when (funcall vertex-filter v)
  37          (incf size)
  38          (incf total (%vertex-degree v edge-filter edge-size)))))
  39     (if size
  40       (values (float (/ total size)))
  41       nil)))
  42
  43 ;;; ---------------------------------------------------------------------------
  44
  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))
  51
  52 ;;; ---------------------------------------------------------------------------
  53
  54 (defun %vertex-degree (vertex edge-filter edge-size)
  55   "Called internally by `vertex-degree` and `average-vertex-degree`."
  56   (let ((degree 0))
  57     (iterate-edges
  58      vertex
  59      (lambda (e)
  60        (when (funcall edge-filter e (other-vertex e vertex))
  61          (incf degree (funcall edge-size e)))))
  62     degree))
  63
  64 ;;; ---------------------------------------------------------------------------
  65
  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."
  69
  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)
  76              (terpri)
  77              (apply #'format t message args)
  78              (format t "~7,2F"
  79                      (average-vertex-degree
  80                       graph
  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))
  88       (dolist (k-1 kinds)
  89         (dolist (k-2 kinds)
  90           (show-avd
  91            (lambda (v) (equal (funcall vertex-classifier v) k-1))
  92            (lambda (e v)
  93              (declare (ignore e))
  94              (equal (funcall vertex-classifier v) k-2))
  95            "Average vertex degree between ~A and ~A:"
  96            k-1 k-2))))))
  97
  98 ;;; ---------------------------------------------------------------------------
  99
 100 #|
 101 Transitivity or Clustering.
 102 the friend of your friend is likely also to be your friend.
 103
 104 C = 3 x number of triangles in the network /
 105     number of connected triples of vertices
 106
 107 or
 108
 109 C = 6 x number of triangles in the network /
 110     number of paths of length two
 111
 112 C measures the fraction of triples that have their third edge *filled in
 113 to complete the triangle.
 114
 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.
 117
 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
 119
 120 Ci = number of triangles connected to vertex i /
 121      number of triples centered on vertex i
 122
 123 For vertices with degree 0 or 1, for which both numerator and denominator are zero,
 124 we put Ci = 0.
 125
 126 C = Sum( Ci ) / n
 127
 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).
 130
 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
 133 |#
 134
 135 (defun average-vertex-clustering-coefficient (graph)
 136   "Returns the average `vertex-clustering-coefficient` of all the vertexes in the graph."
 137   (/
 138    (let ((total 0.0))
 139      (iterate-vertexes
 140       graph (lambda (v) (incf total (vertex-clustering-coefficient v))))
 141      total)
 142    (size graph)))
 143
 144 ;;; ---------------------------------------------------------------------------
 145
 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)
 149     0.0
 150     (float (/ (vertex-triangle-count vertex)
 151               (combination-count (edge-count vertex) 2)))))
 152
 153 ;;; ---------------------------------------------------------------------------
 154
 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))))
 161
 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
 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))))
 180     result))
 181
 182 ;;; ---------------------------------------------------------------------------
 183
 184 (defmethod assortativity-coefficient ((matrix array))
 185
 186   (let* ((matrix (normalize-matrix matrix))
 187          (sum-squared (sum-of-array-elements (matrix-multiply matrix matrix)))
 188          (trace (matrix-trace matrix)))
 189     (if (= trace 1d0)
 190       (values 1)
 191       (values (/ (- trace sum-squared) (- 1 sum-squared))))))
 192
 193 ;;; ---------------------------------------------------------------------------
 194
 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)))
 201     (iterate-edges
 202      graph
 203      (lambda (e)
 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))))
 211     (values
 212      (matrix-multiply matrix (/ (sum-of-array-elements matrix)))
 213      vertex-types)))
 214
 215 #+Test
 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)))
 221
 222 ;;; ---------------------------------------------------------------------------
 223
 224 ;;OPT we call the classifier a lot, probably better to make a new ht for that
 225
 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
 234                                       :initial-element 0
 235                                       :test #'eq))
 236          (class-indexes (make-container 'simple-associative-container
 237                                         :initial-element nil
 238                                         :test #'eq)))
 239     (block determine-class-indexes
 240       (let ((n -1))
 241         (iterate-vertexes
 242          graph
 243          (lambda (v)
 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))))))))
 249
 250     (iterate-vertexes
 251      graph
 252      (lambda (v)
 253        (incf (item-at-1 class-sizes (funcall vertex-classifier v)))))
 254
 255     (iterate-vertexes
 256      graph
 257      (lambda (v-1)
 258        (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
 259          (iterate-neighbors
 260           v-1
 261           (lambda (v-2)
 262             (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
 263               (incf (item-at matrix index-1 index-2))))))))
 264
 265     #+Ignore
 266     (iterate-key-value
 267      class-indexes
 268      (lambda (class-1 index-1)
 269        (iterate-key-value
 270         class-indexes
 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))
 278                                         2))))))))
 279
 280     (values matrix (collect-key-value class-indexes)
 281             (collect-key-value class-sizes))))
 282
 283 #+Test
 284 ;; this computes the same matrix but is probably slower and more consy
 285 (time
 286  (let ((vertex-classes
 287         (merge-nodes
 288          (adma::ds :g-5000)
 289          (lambda (old new)
 290            (push new old))
 291          (lambda (first)
 292            (list first))
 293          :key (lambda (v) (aref (symbol-name (element v)) 0)))))
 294    (loop for (class vertexes) in vertex-classes collect
 295          (list class
 296                (element-counts
 297                 (loop for vertex in vertexes append
 298                       (neighbor-vertexes vertex))
 299                 :key (lambda (v) (aref (symbol-name (element v)) 0)))))))
 300
 301 #+Old
 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
 309                                       :initial-element 0
 310                                       :test #'eq))
 311          (class-indexes (make-container 'simple-associative-container
 312                                         :initial-element nil
 313                                         :test #'eq)))
 314     (block determine-class-indexes
 315       (let ((n -1))
 316         (iterate-vertexes
 317          graph
 318          (lambda (v)
 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))))))))
 324
 325     (iterate-vertexes
 326      graph
 327      (lambda (v)
 328        (incf (item-at-1 class-sizes
 329                         (item-at-1 class-indexes (funcall vertex-classifier v))))))
 330
 331     (iterate-vertexes
 332      graph
 333      (lambda (v-1)
 334        (let ((index-1 (item-at-1 class-indexes (funcall vertex-classifier v-1))))
 335          (iterate-neighbors
 336           v-1
 337           (lambda (v-2)
 338             (let ((index-2 (item-at-1 class-indexes (funcall vertex-classifier v-2))))
 339               ;  (when (= index-1 1 index-2)
 340               ;    (break))
 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)))))))))
 345
 346     (iterate-key-value
 347      class-indexes
 348      (lambda (class-1 index-1)
 349        (iterate-key-value
 350         class-indexes
 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))
 359                                              2) 2)))))))))
 360
 361     (values matrix (collect-key-value class-indexes))))
 362
 363
 364
 365
 366
 367
 368