#lang racket/base
;; Measurement of message delivery latency.

(require racket/match)
(require minimart)
(require logbook)

(provide run)

(struct ping (src dst timestamp) #:transparent)

(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 2) ;; two messages 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 (ping (== dst) (== src) 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
	   (gestalt-union (sub (ping dst src ?))
			  (sub 'kickoff)
			  (pub (ping src dst ?)))))

  (define (echoer id)
    (spawn (lambda (e s)
	     (match e
	       [(message (ping src (== id) stamp) _ _)
		(transition s (send (ping id src stamp)))]
	       [_ #f]))
	   #f
	   (gestalt-union (sub (ping ? id ?))
			  (pub (ping id ? ?)))))

  (begin
    (run-ground (echoer 'base)
		(for/list [(id (in-range (- echoer-count 1)))] (echoer (gensym 'ballast)))
		(pinger 'pinger 'base)
		(send '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" "internal-latency-symbols-not-fixnums"))
  (define T (logbook-table E "internal-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))))