#lang racket/base
;; Measurement of presence processing.
;; Peers observe each other, AND ALSO process the resulting routing events.

(require racket/match)
(require prospect)
(require logbook)

(provide run)

(struct presence (id) #:transparent)

(define presence-proj (compile-projection (advertise (presence (?!)))))

(define (run #:peer-count [peer-count 100])
  (define routing-update-count 0)

  (define (peer id)
    (spawn (lambda (e count)
	     (match e
	       [(? patch? p)
                (set! routing-update-count (+ routing-update-count 1))
                (define-values (added-ids removed-ids) (patch-project/set/single p presence-proj))
                ;; (pretty-print-patch p)
                ;; (pretty-print-patch (patch-project p presence-proj))
                (let* ((count (for/fold [(count count)] [(i added-ids)]
                                ;; (log-info "Adding ~v to ~v at peer ~v" i count id)
                                (+ count i)))
                       (count (for/fold [(count count)] [(i removed-ids)]
                                ;; (log-info "Removing ~v from ~v at peer ~v" i count id)
                                (- count i))))
                  (transition count '()))]
	       [_ #f]))
	   0
           (patch-seq (pub (presence id))
                      (sub (advertise (presence ?))))))

  (define start-time (current-inexact-milliseconds))
  (run-ground (for/list [(id (in-range peer-count))] (peer id)))
  (define stop-time (current-inexact-milliseconds))
  (define delta (- stop-time start-time))
  (values routing-update-count delta))

(module+ main
  (define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "sum-all-prospect"))
  (define T (logbook-table E "presence-processing"
			   #:column-spec '(number-of-peers
                                           secs/routing-update
                                           routing-updates/sec
                                           secs/peer
                                           peers/sec
                                           routing-update-count
                                           run-duration-ms)))
  ;; Warmup
  (let ()
    (run #:peer-count 1)
    (run #:peer-count 10)
    (void))
  ;; Real run
  (for ((n
         (list* 1 2 5
                (let loop ((n 10))
                  (if (>= n 500)
                      '()
                      (cons (inexact->exact (round n))
                            (loop (* n (sqrt (sqrt 2))))))))
	 ))
    (collect-garbage)
    (collect-garbage)
    (collect-garbage)
    (define-values (routing-update-count run-duration-ms) (run #:peer-count n))
    (write-logbook-datum! T (list n
                                  (/ (/ run-duration-ms 1000.0) routing-update-count)
                                  (/ routing-update-count (/ run-duration-ms 1000.0))
                                  (/ (/ run-duration-ms 1000.0) n)
                                  (/ n (/ run-duration-ms 1000.0))
				  routing-update-count
                                  run-duration-ms))))