+2005-06-23 Andy Wingo <wingo@pobox.com>
+
+ * tests/network-clock.scm (plot-simulation): Pipe data to the
+ elite python skript.
+
+ * tests/network-clock-utils.scm (define-parameter): New macro,
+ defines a parameter that can be set via the command line.
+ (set-parameter!, parse-parameter-arguments): Command line args
+ parser.
+
+ * tests/plot-data: Simple matplotlib-based plotter, takes input on
+ stdin.
+
2005-06-23 Jan Schmidt <thaytan@mad.scientist.com>
* gst/elements/gsttypefindelement.c:
(stream-cons start (arithmetic-series (+ start step) step)))
(define (scale-stream stream factor)
- (stream-map (lambda (t) (* t factor)) *absolute-time*))
+ (stream-map (lambda (t) (* t factor)) stream))
(define (stream-while pred proc . streams)
(if (apply pred (map stream-car streams))
;; Queues with a maximum length.
-(define *q-length* 32)
-
(define (make-q l)
(cons l (last-pair l)))
(if (null? (q-tail q))
(make-q tail)
(let ((l (append! (q-head q) tail)))
- (if (> (length (q-head q)) *q-length*)
+ (if (> (length (q-head q)) *queue-length*)
(make-q (cdr (q-head q)))
q)))))
+
+
+;; Parameters, settable via command line arguments.
+
+(define %parameters '())
+(define-macro (define-parameter name val)
+ (let ((str (symbol->string name)))
+ (or (and (eqv? (string-ref str 0) #\*)
+ (eqv? (string-ref str (1- (string-length str))) #\*))
+ (error "Invalid parameter name" name))
+ (let ((param (string->symbol
+ (substring str 1 (1- (string-length str)))))
+ (val-sym (gensym)))
+ `(begin
+ (define ,name #f)
+ (let ((,val-sym ,val))
+ (set! ,name ,val-sym)
+ (set! %parameters (cons (cons ',param ,val-sym)
+ %parameters)))))))
+(define (set-parameter! name val)
+ (define (symbol-append . args)
+ (string->symbol (apply string-append (map symbol->string args))))
+ (or (assq name %parameters)
+ (error "Unknown parameter" name))
+ (module-set! (current-module) (symbol-append '* name '*) val))
+
+(define (parse-parameter-arguments args)
+ (define (usage)
+ (format #t "Usage: ~a ARG1...\n\n" "network-clock.scm")
+ (for-each
+ (lambda (pair)
+ (format #t "\t--~a=VAL \t(default: ~a)\n" (car pair) (cdr pair)))
+ %parameters))
+ (define (unknown-arg arg)
+ (with-output-to-port (current-error-port)
+ (lambda ()
+ (format #t "\nUnknown argument: ~a\n\n" arg)
+ (usage)
+ (quit))))
+ (define (parse-arguments args)
+ (let lp ((in args) (out '()))
+ (cond
+ ((null? in)
+ (reverse! out))
+ ((not (string=? (substring (car in) 0 2) "--"))
+ (unknown-arg (car in)))
+ (else
+ (let ((divider (or (string-index (car in) #\=)
+ (unknown-arg (car in)))))
+ (or (> divider 2) (unknown-arg (car in)))
+ (let ((param (string->symbol (substring (car in) 2 divider)))
+ (val (with-input-from-string (substring (car in) (1+ divider))
+ read)))
+ (lp (cdr in) (acons param val out))))))))
+ (for-each
+ (lambda (pair)
+ (or (false-if-exception
+ (set-parameter! (car pair) (cdr pair)))
+ (unknown-arg (format #f "--~a=~a" (car pair) (cdr pair)))))
+ (parse-arguments args)))
#!/bin/bash
# -*- scheme -*-
-exec guile -l $0 -e main "$@"
+exec guile -l $0 -e main -- "$@"
!#
;; GStreamer
;; is called. In that way all times are actually infinite series.
;;
;; Knobs: sample rate, send delay, receive delay, send noise, receive
-;; noise, queue length, rate of remote clock, rate of local clock.
-;; Fixme: Make knobs more accesible tomorrow; also make graphs.
+;; noise, queue length, rate of remote clock, rate of local clock. See
+;; network-clock.scm --help.
;;
;;; Code:
-(use-modules (ice-9 slib))
+(use-modules (ice-9 slib)
+ (ice-9 popen))
(require 'printf)
(load "network-clock-utils.scm")
-(define *sample-frequency* 40)
-
(define (time->samples t)
(iround (* t *sample-frequency*)))
-(define *absolute-time* (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
-
-(define *empty-event-stream* (stream-of #f))
(define (schedule-event events e time)
(let lp ((response-time (time->samples time))
(schedule-event events (list 'send-time-query) time))
(define (schedule-time-query events l)
- (schedule-event events (list 'time-query l) (+ 0.20 (random 0.20))))
+ (schedule-event events (list 'time-query l)
+ (+ *send-delay* (random *send-noise*))))
(define (schedule-time-response events l r)
- (schedule-event events (list 'time-response l r) (+ 0.20 (random 0.20))))
+ (schedule-event events (list 'time-response l r)
+ (+ *receive-delay* (random *receive-noise*))))
+
(define (network-time remote-time local-time events m b x y)
(let ((r (stream-car remote-time))
(case (and=> event car)
((send-time-query)
- (format #t "sending time query: ~a\n" l)
+ (format #t "; sending time query: ~a\n" l)
(next (schedule-time-query events l) m b x y))
((time-query)
- (format #t "time query received, replying with ~a\n" r)
+ (format #t "; time query received, replying with ~a\n" r)
(next (schedule-time-response events (cadr event) r) m b x y))
((time-response)
(lambda (m b r-squared)
(define (next-time)
(max
- (if (< (length (q-head x)) *q-length*)
+ (if (< (length (q-head x)) *queue-length*)
0
(/ 1 (- 1 (min r-squared 0.99999)) 1000))
0.10))
- (format #t "new slope and offset: ~a ~a (~a)\n" m b r-squared)
+ (format #t "; new slope and offset: ~a ~a (~a)\n" m b r-squared)
(next (schedule-send-time-query events (next-time)) m b x y)))))
(else
(next events m b x y)))))
(define (run-simulation remote-speed local-speed)
- (let ((remote-time (scale-stream *absolute-time* remote-speed))
- (local-time (scale-stream *absolute-time* local-speed)))
- (values
- *absolute-time*
- remote-time
- local-time
- (network-time
- remote-time
- local-time
- (schedule-send-time-query *empty-event-stream* 0.0)
- 1.0
- (stream-car local-time)
- (make-q (list (stream-car local-time)))
- (make-q (list (stream-car remote-time)))))))
+ (let ((absolute-time (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
+ (event-stream (stream-of #f)))
+ (let ((remote-time (scale-stream absolute-time remote-speed))
+ (local-time (scale-stream absolute-time local-speed)))
+ (values
+ absolute-time
+ remote-time
+ local-time
+ (network-time
+ remote-time
+ local-time
+ (schedule-send-time-query event-stream 0.0)
+ 1.0
+ (stream-car local-time)
+ (make-q (list (stream-car local-time)))
+ (make-q (list (stream-car remote-time))))))))
(define (print-simulation total-time sample-rate remote-speed local-speed)
- (display ";; absolute remote local network\n")
+ (display "Absolute time; Remote time; Local time; Network time\n")
(call-with-values
(lambda () (run-simulation remote-speed local-speed))
(lambda streams
(lambda (a r l n) (printf "%.3f %.3f %.3f %.3f\n" a r l n))
streams))))
-(define (main . args)
- (print-simulation 20 #f 2.0 1.1))
+(define (plot-simulation)
+ (let ((port (open-output-pipe "./plot-data Network Clock Simulation")))
+ (with-output-to-port port
+ (lambda ()
+ (print-simulation *total-time* #f *remote-rate* *local-rate*)))
+ (close-pipe port)))
+
+
+(define-parameter *sample-frequency* 40)
+(define-parameter *send-delay* 0.1)
+(define-parameter *receive-delay* 0.1)
+(define-parameter *send-noise* 0.1)
+(define-parameter *receive-noise* 0.1)
+(define-parameter *queue-length* 32)
+(define-parameter *local-rate* 1.0)
+(define-parameter *remote-rate* 1.1)
+(define-parameter *total-time* 5.0)
+
+
+(define (main args)
+ (parse-parameter-arguments (cdr args))
+ (plot-simulation)
+ (quit))
--- /dev/null
+#!/usr/bin/env python
+
+from __future__ import division
+
+import pylab
+import optparse
+import sys
+
+def read_line(fd):
+ l = fd.readline()
+ if not l:
+ return None
+ l = l.strip()
+ if l[0] == ';':
+ return read_line(fd)
+ return [float(x) for x in filter(None, l.split(' '))]
+
+def read_data(fd):
+ data = []
+ l = read_line(fd)
+ while l:
+ data.append(l)
+ l = read_line(fd)
+ return data
+
+def make_xticks(start, end, numticks):
+ return range(int(start), int(end), int((start-end)/numticks))
+
+def make_plot(title):
+ l = sys.stdin.readline()
+ labels = l.strip().split(';')
+ data = read_data(sys.stdin)
+
+ domain = [x[0] for x in data]
+ for i in range(1,len(labels)):
+ pylab.plot(domain, [x[i] for x in data], label=labels[i])
+ pylab.legend()
+ pylab.ylabel(r'Clock time (s)')
+ pylab.xlabel(r'Real time (s)')
+ pylab.title(title)
+ pylab.grid(True)
+ pylab.show()
+
+def main(args):
+ parser = optparse.OptionParser()
+
+ title = ' '.join(args[1:])
+ make_plot(title)
+
+main(sys.argv)
(stream-cons start (arithmetic-series (+ start step) step)))
(define (scale-stream stream factor)
- (stream-map (lambda (t) (* t factor)) *absolute-time*))
+ (stream-map (lambda (t) (* t factor)) stream))
(define (stream-while pred proc . streams)
(if (apply pred (map stream-car streams))
;; Queues with a maximum length.
-(define *q-length* 32)
-
(define (make-q l)
(cons l (last-pair l)))
(if (null? (q-tail q))
(make-q tail)
(let ((l (append! (q-head q) tail)))
- (if (> (length (q-head q)) *q-length*)
+ (if (> (length (q-head q)) *queue-length*)
(make-q (cdr (q-head q)))
q)))))
+
+
+;; Parameters, settable via command line arguments.
+
+(define %parameters '())
+(define-macro (define-parameter name val)
+ (let ((str (symbol->string name)))
+ (or (and (eqv? (string-ref str 0) #\*)
+ (eqv? (string-ref str (1- (string-length str))) #\*))
+ (error "Invalid parameter name" name))
+ (let ((param (string->symbol
+ (substring str 1 (1- (string-length str)))))
+ (val-sym (gensym)))
+ `(begin
+ (define ,name #f)
+ (let ((,val-sym ,val))
+ (set! ,name ,val-sym)
+ (set! %parameters (cons (cons ',param ,val-sym)
+ %parameters)))))))
+(define (set-parameter! name val)
+ (define (symbol-append . args)
+ (string->symbol (apply string-append (map symbol->string args))))
+ (or (assq name %parameters)
+ (error "Unknown parameter" name))
+ (module-set! (current-module) (symbol-append '* name '*) val))
+
+(define (parse-parameter-arguments args)
+ (define (usage)
+ (format #t "Usage: ~a ARG1...\n\n" "network-clock.scm")
+ (for-each
+ (lambda (pair)
+ (format #t "\t--~a=VAL \t(default: ~a)\n" (car pair) (cdr pair)))
+ %parameters))
+ (define (unknown-arg arg)
+ (with-output-to-port (current-error-port)
+ (lambda ()
+ (format #t "\nUnknown argument: ~a\n\n" arg)
+ (usage)
+ (quit))))
+ (define (parse-arguments args)
+ (let lp ((in args) (out '()))
+ (cond
+ ((null? in)
+ (reverse! out))
+ ((not (string=? (substring (car in) 0 2) "--"))
+ (unknown-arg (car in)))
+ (else
+ (let ((divider (or (string-index (car in) #\=)
+ (unknown-arg (car in)))))
+ (or (> divider 2) (unknown-arg (car in)))
+ (let ((param (string->symbol (substring (car in) 2 divider)))
+ (val (with-input-from-string (substring (car in) (1+ divider))
+ read)))
+ (lp (cdr in) (acons param val out))))))))
+ (for-each
+ (lambda (pair)
+ (or (false-if-exception
+ (set-parameter! (car pair) (cdr pair)))
+ (unknown-arg (format #f "--~a=~a" (car pair) (cdr pair)))))
+ (parse-arguments args)))
#!/bin/bash
# -*- scheme -*-
-exec guile -l $0 -e main "$@"
+exec guile -l $0 -e main -- "$@"
!#
;; GStreamer
;; is called. In that way all times are actually infinite series.
;;
;; Knobs: sample rate, send delay, receive delay, send noise, receive
-;; noise, queue length, rate of remote clock, rate of local clock.
-;; Fixme: Make knobs more accesible tomorrow; also make graphs.
+;; noise, queue length, rate of remote clock, rate of local clock. See
+;; network-clock.scm --help.
;;
;;; Code:
-(use-modules (ice-9 slib))
+(use-modules (ice-9 slib)
+ (ice-9 popen))
(require 'printf)
(load "network-clock-utils.scm")
-(define *sample-frequency* 40)
-
(define (time->samples t)
(iround (* t *sample-frequency*)))
-(define *absolute-time* (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
-
-(define *empty-event-stream* (stream-of #f))
(define (schedule-event events e time)
(let lp ((response-time (time->samples time))
(schedule-event events (list 'send-time-query) time))
(define (schedule-time-query events l)
- (schedule-event events (list 'time-query l) (+ 0.20 (random 0.20))))
+ (schedule-event events (list 'time-query l)
+ (+ *send-delay* (random *send-noise*))))
(define (schedule-time-response events l r)
- (schedule-event events (list 'time-response l r) (+ 0.20 (random 0.20))))
+ (schedule-event events (list 'time-response l r)
+ (+ *receive-delay* (random *receive-noise*))))
+
(define (network-time remote-time local-time events m b x y)
(let ((r (stream-car remote-time))
(case (and=> event car)
((send-time-query)
- (format #t "sending time query: ~a\n" l)
+ (format #t "; sending time query: ~a\n" l)
(next (schedule-time-query events l) m b x y))
((time-query)
- (format #t "time query received, replying with ~a\n" r)
+ (format #t "; time query received, replying with ~a\n" r)
(next (schedule-time-response events (cadr event) r) m b x y))
((time-response)
(lambda (m b r-squared)
(define (next-time)
(max
- (if (< (length (q-head x)) *q-length*)
+ (if (< (length (q-head x)) *queue-length*)
0
(/ 1 (- 1 (min r-squared 0.99999)) 1000))
0.10))
- (format #t "new slope and offset: ~a ~a (~a)\n" m b r-squared)
+ (format #t "; new slope and offset: ~a ~a (~a)\n" m b r-squared)
(next (schedule-send-time-query events (next-time)) m b x y)))))
(else
(next events m b x y)))))
(define (run-simulation remote-speed local-speed)
- (let ((remote-time (scale-stream *absolute-time* remote-speed))
- (local-time (scale-stream *absolute-time* local-speed)))
- (values
- *absolute-time*
- remote-time
- local-time
- (network-time
- remote-time
- local-time
- (schedule-send-time-query *empty-event-stream* 0.0)
- 1.0
- (stream-car local-time)
- (make-q (list (stream-car local-time)))
- (make-q (list (stream-car remote-time)))))))
+ (let ((absolute-time (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
+ (event-stream (stream-of #f)))
+ (let ((remote-time (scale-stream absolute-time remote-speed))
+ (local-time (scale-stream absolute-time local-speed)))
+ (values
+ absolute-time
+ remote-time
+ local-time
+ (network-time
+ remote-time
+ local-time
+ (schedule-send-time-query event-stream 0.0)
+ 1.0
+ (stream-car local-time)
+ (make-q (list (stream-car local-time)))
+ (make-q (list (stream-car remote-time))))))))
(define (print-simulation total-time sample-rate remote-speed local-speed)
- (display ";; absolute remote local network\n")
+ (display "Absolute time; Remote time; Local time; Network time\n")
(call-with-values
(lambda () (run-simulation remote-speed local-speed))
(lambda streams
(lambda (a r l n) (printf "%.3f %.3f %.3f %.3f\n" a r l n))
streams))))
-(define (main . args)
- (print-simulation 20 #f 2.0 1.1))
+(define (plot-simulation)
+ (let ((port (open-output-pipe "./plot-data Network Clock Simulation")))
+ (with-output-to-port port
+ (lambda ()
+ (print-simulation *total-time* #f *remote-rate* *local-rate*)))
+ (close-pipe port)))
+
+
+(define-parameter *sample-frequency* 40)
+(define-parameter *send-delay* 0.1)
+(define-parameter *receive-delay* 0.1)
+(define-parameter *send-noise* 0.1)
+(define-parameter *receive-noise* 0.1)
+(define-parameter *queue-length* 32)
+(define-parameter *local-rate* 1.0)
+(define-parameter *remote-rate* 1.1)
+(define-parameter *total-time* 5.0)
+
+
+(define (main args)
+ (parse-parameter-arguments (cdr args))
+ (plot-simulation)
+ (quit))
--- /dev/null
+#!/usr/bin/env python
+
+from __future__ import division
+
+import pylab
+import optparse
+import sys
+
+def read_line(fd):
+ l = fd.readline()
+ if not l:
+ return None
+ l = l.strip()
+ if l[0] == ';':
+ return read_line(fd)
+ return [float(x) for x in filter(None, l.split(' '))]
+
+def read_data(fd):
+ data = []
+ l = read_line(fd)
+ while l:
+ data.append(l)
+ l = read_line(fd)
+ return data
+
+def make_xticks(start, end, numticks):
+ return range(int(start), int(end), int((start-end)/numticks))
+
+def make_plot(title):
+ l = sys.stdin.readline()
+ labels = l.strip().split(';')
+ data = read_data(sys.stdin)
+
+ domain = [x[0] for x in data]
+ for i in range(1,len(labels)):
+ pylab.plot(domain, [x[i] for x in data], label=labels[i])
+ pylab.legend()
+ pylab.ylabel(r'Clock time (s)')
+ pylab.xlabel(r'Real time (s)')
+ pylab.title(title)
+ pylab.grid(True)
+ pylab.show()
+
+def main(args):
+ parser = optparse.OptionParser()
+
+ title = ' '.join(args[1:])
+ make_plot(title)
+
+main(sys.argv)