minimart-benchmark-2017/observe-some-syndicate.rkt

97 lines
3.9 KiB
Racket

#lang racket/base
;; Measurement of presence processing.
;; Peers observe just one distinguished peer, and do not process resulting routing events.
(require racket/match)
(require prospect)
(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
[(? patch? p)
(set! routing-update-count (+ routing-update-count 1))
(transition (+ count 1) '())]
[_ #f]))
0
(patch-seq (assert (client))
;; (assert (observe (server ?)))
)))
(define (spawn-server id)
(spawn (lambda (e count)
(match e
[(? patch? p)
(set! routing-update-count (+ routing-update-count 1))
(transition (+ count 1) '())]
[_ #f]))
0
(patch-seq ;; (assert (server id))
(assert (observe (client))))))
(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-prospect"))
(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)))))