A program to simulate mesh propagation and score accumulation in gossipsub

scoresim.ss

;; -*- Gerbil -*-
(import :std/sugar
        :std/getopt
        :std/iter
        :std/srfi/1
        :std/misc/pqueue
        :std/misc/shuffle
        :gerbil/gambit)
(export main)

(declare (not safe))

(defstruct node (id seen score conns mesh)
  final: #t)

(def (run-sim N P C D Dhi Dlo fp?)
  ;; create N nodes
  (def nodes (make-vector N #f))
  (for (i (in-range N))
    (vector-set! nodes i (make-node i (make-hash-table-eq) (make-hash-table-eq) [] [])))

  ;; create C connections per node
  (for (n nodes)
    (def i (node-id n))
    (for (_ (in-range C))
      (let again ()
        (def j (random-integer N))
        (cond
         ((fx= i j) (again))
         ((memq j (node-conns n)))
         (else
          (let (nn (vector-ref nodes j))
            (set! (node-conns n) (cons j (node-conns n)))
            (set! (node-conns nn) (cons i (node-conns nn)))))))))

  ;; create the mesh
  (for (n nodes)
    (def i (node-id n))
    (def d (length (node-mesh n)))
    (when (fx< d D)
      (for (_ (in-range (fx- D d)))
        (let again ()
          (def jx (random-integer (length (node-conns n))))
          (def j (list-ref (node-conns n) jx))
          (def nn (vector-ref nodes j))
          (cond
           ((fx> (length (node-mesh nn)) Dhi)
            (again))
           ((memq j (node-mesh n))
            (again))
           (else
            (set! (node-mesh n) (cons j (node-mesh n)))
            (set! (node-mesh nn) (cons i (node-mesh nn)))))))))

  ;; select P publishers
  (def publishers
    (take (shuffle (vector->list nodes)) P))

  ;; message delivery queue
  ;; delivery events are lists [time message-id dest-node-id src-node-id]
  (def pq (make-pqueue car fl< N))

  ;; link latencies: maps every (connected) pair of nodes (i, i) to a random real
  (def latency (make-hash-table-eq))
  (def (link-latency n1 n2)
    (def key (fx+ (fx* (node-id n1) 1000000) (node-id n2)))
    (def key2 (fx+ (fx* (node-id n2) 1000000) (node-id n1)))
    (cond
     ((hash-get latency key) => values)
     (else
      (let (lat (random-real))
        (hash-put! latency key lat)
        (hash-put! latency key2 lat)
        lat))))

  (def (publish! n msg-id)
    (for (i (if fp? (node-conns n) (node-mesh n)))
      (def nn (vector-ref nodes i))
      (def dt (link-latency n nn))
      (hash-put! (node-seen n) msg-id #t)
      (pqueue-push! pq [dt msg-id (node-id nn) (node-id n)])))

  (def (deliver! n msg-id t from)
    (unless (hash-get (node-seen n) msg-id)
      (hash-put! (node-seen n) msg-id #t)
      (hash-update! (node-score n) from 1+ 0)
      (for (i (node-mesh n))
        (def nn (vector-ref nodes i))
        (unless (eq? (node-id nn) from)
          (let (dt (link-latency n nn))
            (pqueue-push! pq [(fl+ t dt) msg-id (node-id nn) (node-id n)]))))))

  ;; publish a message from each publisher
  (for ((p publishers) (msg-id (in-naturals)))
    (publish! p msg-id)
    ;; run the propagation simulation to its end
    (while (not (pqueue-empty? pq))
      (with ([t msg-id dest src] (pqueue-pop! pq))
        (deliver! (vector-ref nodes dest) msg-id t src))))

  nodes)

(def (display-results nodes)
  (for (n nodes)
    (displayln
     (cons (node-id n)
           (map (lambda (i) (cons i (hash-get (node-score n) i)))
                (node-mesh n))))))

(def (main . args)
  (def gopt
    (getopt
     (option 'nodes "-n" "--nodes"
             help: "number of nodes"
             value: string->number
             default: 10000)
     (option 'publishers "-p" "--publishers"
             help: "number of publishers"
             value: string->number
             default: 100)
     (option 'conns "-c" "--conns"
             help: "number of connections per node"
             value: string->number
             default: 50)
     (option 'D "-D"
             help: "Overlay D"
             value: string->number
             default: 8)
     (option 'Dhi "-Dhi"
             help: "Overlay D_hi"
             default: 12)
     (option 'Dlo "-Dlo"
             help: "Overlay D_lo"
             default: 6)
     (flag 'flood-publish "-f" "--flood-publish"
           help: "use flood publishing")))
  (try
   (let (opt (getopt-parse gopt args))
     (let-hash opt
       (display-results (run-sim .nodes .publishers .conns .D .Dhi .Dlo .?flood-publish))))
   (catch (getopt-error? e)
     (getopt-display-help e "scoresim" (current-error-port))
     (exit 1))
   (catch (e)
     (display-exception e (current-error-port))
     (exit 2))))