some code to check the gossipsub overlay construction algorithm for connectivity

rgraph.ss

;; -*- 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)))