observe-some-{minimart,prospect}.rkt
This commit is contained in:
parent
cde22db3dd
commit
bfa04b3f13
|
@ -0,0 +1,99 @@
|
||||||
|
#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 2000)
|
||||||
|
'()
|
||||||
|
(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)))))
|
|
@ -0,0 +1,96 @@
|
||||||
|
#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
|
||||||
|
(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
|
||||||
|
(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 2000)
|
||||||
|
'()
|
||||||
|
(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)))))
|
Loading…
Reference in New Issue