#lang racket/base
;; Measurement of presence processing.
;; Peers observe just one distinguished peer, and do not process resulting routing events.

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

(provide run)

(struct client () #:transparent)
(struct server (id) #:transparent)

(define (run #:peer-count [peer-count 100] #:client-first? [client-first? #f])
  (define routing-update-count 0)

  (define (spawn-client)
    (spawn (lambda (e count)
             (match e
               [(routing-update g)
                (set! routing-update-count (+ routing-update-count 1))
                (transition (+ count 1) '())]
               [_ #f]))
           0
           (pub (client))
           ;; (gestalt-union (pub (client))
           ;;                (sub (server ?) #:level 1))
           ))

  (define (spawn-server id)
    (spawn (lambda (e count)
	     (match e
	       [(routing-update g)
                (set! routing-update-count (+ routing-update-count 1))
                ;; (log-info "count for ~v is now ~v" id (+ count 1))
                ;; (log-info "~a" (gestalt->pretty-string g))
                (transition (+ count 1) '())]
	       [_ #f]))
	   0
           (gestalt-union ;; (pub (server id))
                          (sub (client) #:level 1))))

  (define client-action (spawn-client))
  (define server-actions (for/list [(id (in-range (- peer-count 1)))] (spawn-server id)))
  (define-values (results cpu-total-ms wall-ms cpu-gc-ms)
    (time-apply (lambda ()
                  (run-ground (if client-first?
                                  (cons client-action server-actions)
                                  (cons server-actions client-action))))
                '()))
  (values routing-update-count (max 1 (- cpu-total-ms cpu-gc-ms))))

(module+ main
  (define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "observe-some-minimart"))
  (define T-client-first (logbook-table E "presence-processing-narrow-client-first"
                                        #:column-spec '(number-of-peers
                                                        secs/routing-update
                                                        routing-updates/sec
                                                        secs/peer
                                                        peers/sec
                                                        routing-update-count
                                                        run-duration-ms)))
  (define T-client-last (logbook-table E "presence-processing-narrow-client-last"
                                       #: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 5)
         (list* 2 5
                (let loop ((n 10))
                  (if (>= n 4000)
                      '()
                      (cons (inexact->exact (round n))
                            (loop (* n (sqrt (sqrt 2))))))))
	 ))
    (collect-garbage)
    (collect-garbage)
    (collect-garbage)
    (for ((client-first? (list #t #f)))
      (define-values (routing-update-count run-duration-ms)
        (run #:peer-count n #:client-first? client-first?))
      (write-logbook-datum! (if client-first? T-client-first T-client-last)
                            (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)))))