From af178f64979aa457ead71c83ea657000f6db38d4 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Thu, 15 Oct 2015 19:01:47 -0400
Subject: [PATCH] Broadcast measurements

---
 broadcast-latency-prospect.rkt | 111 +++++++++++++++++++++++++++++++++
 run-all.sh                     |   1 +
 2 files changed, 112 insertions(+)
 create mode 100644 broadcast-latency-prospect.rkt

diff --git a/broadcast-latency-prospect.rkt b/broadcast-latency-prospect.rkt
new file mode 100644
index 0000000..388b266
--- /dev/null
+++ b/broadcast-latency-prospect.rkt
@@ -0,0 +1,111 @@
+#lang racket/base
+;; Measurement of *broadcast* message delivery latency.
+
+(require racket/match)
+(require prospect)
+(require logbook)
+
+(provide run)
+
+(struct ping (src dst timestamp) #:transparent)
+(struct pong (timestamp) #:transparent)
+
+(define (send-ping src dst)
+  (message (ping src dst (current-inexact-milliseconds))))
+
+(define (run #:echoer-count [echoer-count 100]
+	     #:run-time [run-time 10000])
+  (define total-latency 0)
+  (define total-roundtrips 0)
+  (define boot-start-time (current-inexact-milliseconds))
+  (define run-start-time #f)
+
+  (define (rate-at count)
+    ;; count is the number of roundtrips
+    ;; each roundtrip involves (+ echoer-count 1) messages
+    ;; we want messages per second
+    (/ (* count (+ echoer-count 1)) ;; echoer-count pings and one pong per roundtrip
+       (/ total-latency 1000.0) ;; latency in seconds
+       ))
+
+  (define (pinger src dst)
+    (spawn (lambda (e s)
+	     (match e
+	       [(message 'kickoff)
+		(set! run-start-time (current-inexact-milliseconds))
+		(transition s (send-ping src dst))]
+	       [(message (pong start-time))
+		(define stop-time (current-inexact-milliseconds))
+		;; TODO: is there a way of reducing the measurement error here,
+		;; perhaps by recording against run-start-time instead of start-time, somehow?
+		;; TODO: first, characterize the measurement error
+		(define delta (- stop-time start-time))
+		(set! total-latency (+ total-latency delta))
+		(set! total-roundtrips (+ total-roundtrips 1))
+		(when (zero? (modulo total-roundtrips 1000))
+		  (log-info "After ~a roundtrips, ~a milliseconds; ~a Hz"
+			    total-roundtrips
+			    total-latency
+			    (rate-at total-roundtrips)))
+		(transition s
+			    (if (< (- stop-time run-start-time) run-time)
+				(send-ping src dst)
+				'()))]
+	       [_ #f]))
+	   #f
+           (sub (pong ?))
+           (sub 'kickoff)
+           (pub (ping src dst ?))))
+
+  (define (echoer id)
+    (spawn (lambda (e s)
+	     (match e
+	       [(message (ping src (== id) stamp))
+		(transition s (message (pong stamp)))]
+	       [_ #f]))
+	   #f
+	   (sub (ping ? ? ?))
+           (pub (pong ?))))
+
+  (begin
+    (run-ground (for/list [(id (in-range echoer-count))] (echoer id))
+		(pinger echoer-count 0)
+		(message 'kickoff))
+    (values total-roundtrips (rate-at total-roundtrips) (- run-start-time boot-start-time))))
+
+(module+ main
+  (define t 10000)
+  (define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "broadcast-latency-prospect"))
+  (define T (logbook-table E "broadcast-latency"
+			   #:column-spec '(number-of-echoers
+					   secs/msg
+					   msgs/sec
+					   boot-delay-ms
+					   secs/process-booted
+					   roundtrip-count
+					   run-duration-ms)))
+  ;; Warmup
+  (let ()
+    (run #:echoer-count 1 #:run-time 1000)
+    (run #:echoer-count 10 #:run-time 1000)
+    (void))
+  ;; Real run
+  (for ((n
+         (list* 1 2 5
+                (let loop ((n 10))
+                  (if (>= n 30000)
+                      '()
+                      (cons (inexact->exact (round n))
+                            (loop (* n (sqrt (sqrt 2))))))))
+	 ))
+    (collect-garbage)
+    (collect-garbage)
+    (collect-garbage)
+    (define-values (count v boot-delay-ms) (run #:echoer-count n #:run-time t))
+    (write-logbook-datum! T (list n
+				  (/ 1.0 v)
+				  v
+				  boot-delay-ms
+				  (/ (/ boot-delay-ms 1000.0) n)
+				  count
+				  t))))
diff --git a/run-all.sh b/run-all.sh
index a710221..9d234ec 100755
--- a/run-all.sh
+++ b/run-all.sh
@@ -18,6 +18,7 @@ racket external-latency.rkt --max-waypoint $MAX_WAYPOINT --racket
 
 racket internal-latency.rkt
 racket internal-latency-prospect.rkt
+racket broadcast-latency-prospect.rkt
 
 racket observe-all-minimart.rkt
 racket observe-all-prospect.rkt