#lang imperative-syndicate/test-implementation
;; Measurement of *broadcast* message delivery latency.

(require logbook)

(message-struct ping (src dst timestamp))
(message-struct pong (timestamp))

(define (send-ping! src dst)
  (send! (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
       ))

  (test-case
      [(for [(id (in-range echoer-count))]
         (spawn (on (message (ping $src $dst $stamp))
                    (when (= dst id) (send! (pong stamp))))))

       (let ((src echoer-count)
             (dst 0))
         (spawn (on-start (flush!)
                          (set! run-start-time (current-inexact-milliseconds))
                          (send-ping! src dst))

                (on (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 10000))
                      (log-info "After ~a roundtrips, ~a milliseconds; ~a Hz"
                                total-roundtrips
                                total-latency
                                (rate-at total-roundtrips)))
                    (when (< (- stop-time run-start-time) run-time)
                      (send-ping! src dst)))))])
  (values total-roundtrips
          (rate-at total-roundtrips)
          (- run-start-time boot-start-time)))

(module+ main
  (define t 5000)
  (define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "broadcast-latency-imperative-syndicate"))
  (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))))