tests/network-clock.scm (plot-simulation): Pipe data to the elite python skript.
authorAndy Wingo <wingo@pobox.com>
Thu, 23 Jun 2005 13:20:44 +0000 (13:20 +0000)
committerAndy Wingo <wingo@pobox.com>
Thu, 23 Jun 2005 13:20:44 +0000 (13:20 +0000)
Original commit message from CVS:
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.

ChangeLog
tests/misc/network-clock-utils.scm
tests/misc/network-clock.scm
tests/misc/plot-data [new file with mode: 0755]
tests/network-clock-utils.scm
tests/network-clock.scm
tests/plot-data [new file with mode: 0755]

index 472b567..d151ded 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+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:
index cdb82a4..d626903 100644 (file)
   (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)))
index c62a33a..50b4aaa 100755 (executable)
@@ -1,6 +1,6 @@
 #!/bin/bash
 # -*- scheme -*-
-exec guile -l $0 -e main "$@"
+exec guile -l $0 -e main -- "$@"
 !#
 
 ;; GStreamer
@@ -55,26 +55,22 @@ exec guile -l $0 -e main "$@"
 ;; 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))
@@ -89,10 +85,13 @@ exec guile -l $0 -e main "$@"
   (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))
@@ -108,11 +107,11 @@ exec guile -l $0 -e main "$@"
 
     (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)
@@ -123,34 +122,36 @@ exec guile -l $0 -e main "$@"
            (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
@@ -160,5 +161,26 @@ exec guile -l $0 -e main "$@"
        (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))
diff --git a/tests/misc/plot-data b/tests/misc/plot-data
new file mode 100755 (executable)
index 0000000..2edb9c9
--- /dev/null
@@ -0,0 +1,50 @@
+#!/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)
index cdb82a4..d626903 100644 (file)
   (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)))
index c62a33a..50b4aaa 100755 (executable)
@@ -1,6 +1,6 @@
 #!/bin/bash
 # -*- scheme -*-
-exec guile -l $0 -e main "$@"
+exec guile -l $0 -e main -- "$@"
 !#
 
 ;; GStreamer
@@ -55,26 +55,22 @@ exec guile -l $0 -e main "$@"
 ;; 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))
@@ -89,10 +85,13 @@ exec guile -l $0 -e main "$@"
   (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))
@@ -108,11 +107,11 @@ exec guile -l $0 -e main "$@"
 
     (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)
@@ -123,34 +122,36 @@ exec guile -l $0 -e main "$@"
            (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
@@ -160,5 +161,26 @@ exec guile -l $0 -e main "$@"
        (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))
diff --git a/tests/plot-data b/tests/plot-data
new file mode 100755 (executable)
index 0000000..2edb9c9
--- /dev/null
@@ -0,0 +1,50 @@
+#!/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)