Created
February 24, 2018 12:04
-
-
Save vyzo/b89413c1dbd991682cba8df490d284f3 to your computer and use it in GitHub Desktop.
some code to check the gossipsub overlay construction algorithm for connectivity
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; -*- 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