Skip to content

Instantly share code, notes, and snippets.

@vyzo
Created February 24, 2018 12:04
Show Gist options
  • Save vyzo/b89413c1dbd991682cba8df490d284f3 to your computer and use it in GitHub Desktop.
Save vyzo/b89413c1dbd991682cba8df490d284f3 to your computer and use it in GitHub Desktop.
some code to check the gossipsub overlay construction algorithm for connectivity
;; -*- Gerbil -*-
(import :gerbil/gambit/random
:std/misc/shuffle
(only-in :std/srfi/1 take))
(export (struct-out node)
node-degree
node-graft!
node-prune!
make-graph
graph-check-connected
)
(declare (fixnum))
(def D 6)
(def D-low 4)
(def D-high 12)
(defstruct node (id p))
(def (node-degree n)
(length (node-p n)))
(def (node-graft! n1 n2)
(link! n1 n2)
(link! n2 n1))
(def (link! n1 n2)
(unless (memq n2 (node-p n1))
(set! (node-p n1)
(cons n2 (node-p n1)))))
(def (node-prune! n1 n2)
(unlink! n1 n2)
(unlink! n2 n1))
(def (unlink! n1 n2)
(when (memq n2 (node-p n1))
(set! (node-p n1)
(remq n2 (node-p n1)))))
(def (make-graph N
steps: (steps 100)
D: (d D)
D-low: (dlo D-low)
D-high: (dhi D-high))
(def nodes
(map (lambda (n) (make-node n []))
(iota N)))
(def peers
(list->vector nodes))
(def (take-peers count)
(let lp ((i 0) (r []))
(if (< i count)
(let (j (random-integer (vector-length peers)))
(lp (1+ i) (cons (vector-ref peers j) r)))
r)))
(def (step!)
(let lp ((rest nodes) (diff #f))
(match rest
([n . rest]
(cond
((< (node-degree n) dlo)
(let* ((ineed (- d (node-degree n)))
(candidates (take-peers ineed))
(new-peers (filter (lambda (x) (not (eq? x n))) candidates)))
(for-each (cut node-graft! n <>) new-peers)
(lp rest #t)))
((> (node-degree n) dhi)
(let* ((todrop (- (node-degree n) d))
(peers (shuffle (node-p n)))
(drop-peers (take peers todrop)))
(for-each (cut node-prune! n <>) drop-peers)
(lp rest #t)))
(else
(lp rest diff))))
(else diff))))
(def (connect!)
(let lp ((i 0))
(when (< i steps)
(displayln "step " i)
(when (step!)
(lp (1+ i))))))
(connect!)
nodes)
(def (graph-check-connected nodes)
(def visited (make-hash-table-eq))
(def (visit! n)
(unless (hash-get visited n)
(hash-put! visited n #t)
(for-each visit! (node-p n))))
(visit! (car nodes))
(cond
((find (lambda (n) (not (hash-get visited n))) nodes)
=> values)
(else 'connected)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment