diff --git a/log-check.rkt b/log-check.rkt new file mode 100644 index 0000000..1dfb01a --- /dev/null +++ b/log-check.rkt @@ -0,0 +1,60 @@ +#lang racket/base +(require racket/file + racket/list + racket/function + racket/match + math/base) + +;; The idea here is that the average gap should be about 16.6. In the +;; first version, the numbers were: +;; +;; 1734 Events +;; word-evt: #294, average gap 34.903754432860495 +;; word-tick: #27, average gap 43.47511643629808 +;; word-output: #293, average gap 34.90750665534033 +;; word-label: #293, average gap 33.786167092519264 +;; word-fps: #559, average gap 17.674883442540324 +;; word-event: #267, average gap 37.07471437382519 +;; word-return: #1, average gap 0 +;; +;; This is really bad. The goal should be for the counts for +;; word-(evt,output,label,fps) to all be the same as tick + +(module+ main + (require racket/runtime-path) + (define-runtime-path log-p "log") + + (define events (file->list log-p)) + + (printf "~a Events\n" (length events)) + + (define label->times (make-hasheq)) + (for ([e (in-list events)]) + (match-define (cons t i) e) + (hash-update! label->times i (curry cons t) empty)) + + (define (average l) + (if (empty? l) + 0 + (/ (sum l) (length l)))) + + (define (gaps ts) + (let loop ([last #f] + [ts (sort ts <=)]) + (cond + [(empty? ts) + empty] + [(not last) + (loop (first ts) (rest ts))] + [else + (define t (first ts)) + (cons (- t last) + (loop t (rest ts)))]))) + + (define (average-gap ts) + (average (gaps ts))) + (for ([(i ts) (in-hash label->times)]) + (printf "~a: #~a, average gap ~a\n" + i + (length ts) + (average-gap ts)))) diff --git a/word.rkt b/word.rkt index 75391ff..3b32d13 100644 --- a/word.rkt +++ b/word.rkt @@ -68,13 +68,13 @@ (define new-w (f w)) (match new-w [#f - (word-return w)] + ((LOG! word-return) w)] [_ - (chaos-output! c (word-output new-w)) + (chaos-output! c ((LOG! word-output) new-w)) (define end-time (current-inexact-milliseconds)) (define frame-time (fl- end-time start-time)) (define new-label - (word-label new-w frame-time)) + ((LOG! word-label) new-w frame-time)) (chaos-label! c new-label) (define next-time (make-next-time new-w start-time)) (body next-time new-w)])) @@ -85,15 +85,15 @@ (define (body next-time w) (define input-evt (handle-evt - (choice-evt (word-evt w) + (choice-evt ((LOG! word-evt) w) (chaos-event c)) (λ (e) (update-word w (λ (w) - (word-event w e)) + ((LOG! word-event) w e)) (λ (new-w start-time) - (define old-fps (word-fps w)) - (define fps (word-fps new-w)) + (define old-fps ((LOG! word-fps) w)) + (define fps ((LOG! word-fps) new-w)) (if (= old-fps fps) next-time (compute-next-time start-time fps))))))) @@ -102,9 +102,9 @@ (alarm-evt next-time) (λ (_) (update-word w - word-tick + (LOG! word-tick) (λ (new-w start-time) - (define fps (word-fps new-w)) + (define fps ((LOG! word-fps) new-w)) (compute-next-time start-time fps)))))) (sync/timeout (λ () @@ -114,6 +114,12 @@ input-evt)) (chaos-swap! c (λ () (body 0 w)))) +(define-syntax-rule (LOG! id) + (begin (LOG!* 'id) id)) +(define (LOG!* i) + (writeln (cons (current-inexact-milliseconds) i)) + (flush-output)) + (provide gen:word (contract-out