81 lines
3.1 KiB
Racket
81 lines
3.1 KiB
Racket
|
#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]
|
||
|
#:run-time [run-time 10000])
|
||
|
(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
|
||
|
(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 t 5000)
|
||
|
(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-time 1000)
|
||
|
(run #:peer-count 10 #:run-time 1000)
|
||
|
(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 #:run-time t))
|
||
|
(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))))
|