minimart-benchmark-2017/sum-all-imperative-syndicat...

57 lines
2.2 KiB
Racket

#lang imperative-syndicate/test-implementation
;; Measurement of presence processing.
;; Peers observe each other, AND ALSO process the resulting routing events.
(require logbook)
(assertion-struct presence (id))
(define (run #:peer-count [peer-count 100])
(define event-count 0)
(define start-time (current-inexact-milliseconds))
(test-case [(for [(id (in-range peer-count))]
(spawn (assert (presence id))
(field [peer-count 0])
(on (asserted (presence $peer))
(set! event-count (+ event-count 1))
(peer-count (+ (peer-count) 1)))))])
(define stop-time (current-inexact-milliseconds))
(define delta (- stop-time start-time))
(values event-count delta))
(module+ main
(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "sum-all-imperative-syndicate"))
(define T (logbook-table E "presence-processing"
#:column-spec '(number-of-peers
secs/event
events/sec
secs/peer
peers/sec
event-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 1000)
'()
(cons (inexact->exact (round n))
(loop (* n (sqrt (sqrt 2))))))))
))
(collect-garbage)
(collect-garbage)
(collect-garbage)
(define-values (event-count run-duration-ms) (run #:peer-count n))
(write-logbook-datum! T (list n
(/ (/ run-duration-ms 1000.0) event-count)
(/ event-count (/ run-duration-ms 1000.0))
(/ (/ run-duration-ms 1000.0) n)
(/ n (/ run-duration-ms 1000.0))
event-count
run-duration-ms))))