diff --git a/observe-some-minimart.rkt b/observe-some-minimart.rkt new file mode 100644 index 0000000..ebf5c14 --- /dev/null +++ b/observe-some-minimart.rkt @@ -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))))) diff --git a/observe-some-prospect.rkt b/observe-some-prospect.rkt new file mode 100644 index 0000000..b6e897f --- /dev/null +++ b/observe-some-prospect.rkt @@ -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)))))