tests/network-clock-utils.scm (debug, print-event): New utils.

Original commit message from CVS:
2005-06-28  Andy Wingo  <wingo@pobox.com>

* tests/network-clock-utils.scm (debug, print-event): New utils.

* tests/network-clock.scm (*debug*, *with-graph*): New parameters.
(*packet-loss*): Unified loss probability.
(network-time): Report out-of-band events.

* tests/plot-data: Add support for out-of-band events. Hack it
into this script instead of passing it down the pipe; should fix
this later.

ChangeLog

@@ -1,3 +1,15 @@
+2005-06-28  Andy Wingo  <wingo@pobox.com>
+
+	* tests/network-clock-utils.scm (debug, print-event): New utils.
+
+	* tests/network-clock.scm (*debug*, *with-graph*): New parameters.
+	(*packet-loss*): Unified loss probability.
+	(network-time): Report out-of-band events.
+
+	* tests/plot-data: Add support for out-of-band events. Hack it
+	into this script instead of passing it down the pipe; should fix
+	this later.
+
 2005-06-28  Wim Taymans  <wim@fluendo.com>
 
 	* docs/gst/gstreamer.types:

tests/misc/network-clock-utils.scm

@@ -62,6 +62,13 @@
 (define (sq x)
   (* x x))
 
+(define (debug str . args)
+  (if *debug*
+      (apply format (current-error-port) str args)))
+
+(define (print-event kind x y)
+  (format #t "~a ~a ~a\n" kind x y))
+
 ;; Linear least squares.
 ;;
 ;; See http://mathworld.wolfram.com/LeastSquaresFitting.html

tests/misc/network-clock.scm

@@ -1,6 +1,6 @@
 #!/bin/bash
 # -*- scheme -*-
-exec guile -l $0 -e main -- "$@"
+exec guile --debug -l $0 -e main -- "$@"
 !#
 
 ;; GStreamer
@@ -71,31 +71,25 @@ exec guile -l $0 -e main -- "$@"
   (iround (* t *sample-frequency*)))
 
 
-(define (schedule-event events e time loss-probability)
+(define (schedule-event events e time)
   (let lp ((response-time (time->samples time))
            (stream events))
     (if (zero? response-time)
         (if (not (stream-car stream))
-            (if (< (random 1.0) loss-probability)
+            (stream-cons e (stream-cdr stream))
-                stream ;; drop the event
-                (stream-cons e (stream-cdr stream)))
             (stream-cons (stream-car stream) (lp 0 (stream-cdr stream))))
         (stream-cons (stream-car stream) (lp (1- response-time) (stream-cdr stream))))))
 
 (define (schedule-send-time-query events time)
-  (schedule-event events (list 'send-time-query) time 0.0))
+  (schedule-event events (list 'send-time-query) time))
 
 (define (schedule-time-query events l)
   (schedule-event events (list 'time-query l)
-                  (+ *send-delay* (random *send-jitter*)) *send-loss*))
+                  (+ *send-delay* (random *send-jitter*))))
 
 (define (schedule-time-response events l r)
   (schedule-event events (list 'time-response l r)
-                  (+ *recv-delay* (random *recv-jitter*)) *recv-loss*))
+                  (+ *recv-delay* (random *recv-jitter*))))
-
-
-(define (timeout-- t)
-  (- t (/ 1 *sample-frequency*)))
 
 (define (network-time remote-time local-time events m b x y t)
   (let ((r (stream-car remote-time))
@@ -111,12 +105,19 @@ exec guile -l $0 -e main -- "$@"
 
     (case (and=> event car)
       ((send-time-query)
-       (format #t "; sending time query: ~a\n" l)
+       (cond
-       (next (schedule-time-query events l) m b x y *timeout*))
+        ((< (random 1.0) *packet-loss*)
+         (debug "; dropped time query: ~a\n" l)
+         (print-event 'packet-lost l (+ (* m l) b))
+         (next events m b x y (time->samples *timeout*)))
+        (else
+         (debug "; sending time query: ~a\n" l)
+         (print-event 'packet-sent l (+ (* m l) b))
+         (next (schedule-time-query events l) m b x y (time->samples *timeout*)))))
 
       ((time-query)
-       (format #t "; time query received, replying with ~a\n" r)
+       (debug "; time query received, replying with ~a\n" r)
-       (next (schedule-time-response events (cadr event) r) m b x y (timeout-- t)))
+       (next (schedule-time-response events (cadr event) r) m b x y (and t (1- t))))
 
       ((time-response)
        (let ((x (q-push x (avg (cadr event) l)))
@@ -130,7 +131,9 @@ exec guile -l $0 -e main -- "$@"
                     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)
+             (debug "; new slope and offset: ~a ~a (~a)\n" m b r-squared)
+             (print-event 'packet-observed (avg (cadr event) l) (caddr event))
+             (print-event 'packet-received l (+ (* m l) b))
              (next (schedule-send-time-query events (next-time)) m b x y #f)))))
 
       (else
@@ -138,11 +141,11 @@ exec guile -l $0 -e main -- "$@"
         ((not t)
          ;; not waiting for a response
          (next events m b x y t))
-        ((<= t 0.0)
+        ((<= t 0)
          ;; we timed out
-         (next (schedule-send-time-query events 0.0) m b x y 0.0))
+         (next (schedule-send-time-query events 0.0) m b x y 0))
         (else
-         (next events m b x y (timeout-- t))))))))
+         (next events m b x y (1- t))))))))
 
 (define (run-simulation remote-speed local-speed)
   (let ((absolute-time (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
@@ -163,30 +166,28 @@ exec guile -l $0 -e main -- "$@"
         (make-q (list (stream-car remote-time)))
         #f)))))
 
-(define (print-simulation total-time sample-rate remote-speed local-speed)
+(define (print-simulation)
   (display "Absolute time; Remote time; Local time; Network time\n")
   (call-with-values
-      (lambda () (run-simulation remote-speed local-speed))
+      (lambda () (run-simulation *remote-rate* *local-rate*))
     (lambda streams
       (apply
        stream-while
-       (lambda (a r l n) (<= a total-time))
+       (lambda (a r l n) (<= a *total-time*))
        (lambda (a r l n) (format #t "~a ~a ~a ~a\n" a r l n))
        streams))))
 
 (define (plot-simulation)
   (let ((port (open-output-pipe "./plot-data Network Clock Simulation")))
     (with-output-to-port port
-      (lambda ()
+      print-simulation)
-        (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 *recv-delay* 0.1)
-(define-parameter *send-loss* 0.02)
+(define-parameter *packet-loss* 0.01)
-(define-parameter *recv-loss* 0.02)
 (define-parameter *send-jitter* 0.1)
 (define-parameter *recv-jitter* 0.1)
 (define-parameter *queue-length* 32)
@@ -194,9 +195,13 @@ exec guile -l $0 -e main -- "$@"
 (define-parameter *remote-rate* 1.1)
 (define-parameter *total-time* 5.0)
 (define-parameter *timeout* 1.0)
+(define-parameter *debug* #f)
+(define-parameter *with-graph* #t)
 
 
 (define (main args)
   (parse-parameter-arguments (cdr args))
-  (plot-simulation)
+  (if *with-graph*
+      (plot-simulation)
+      (print-simulation))
   (quit))

tests/misc/plot-data

@@ -6,22 +6,40 @@ import pylab
 import optparse
 import sys
 
-def read_line(fd):
+def parse_data(l, state):
+    state['data'].append([float(x) for x in filter(None, l.split(' '))])
+    return state
+
+def parse_event(l, state):
+    components = filter(None, l.split(' '))
+    vals = [float(x) for x in components[1:]]
+    if not components[0] in state:
+        state[components[0]] = [vals]
+    else:
+        state[components[0]].append(vals)
+    return state
+
+def read_line(fd, state):
     l = fd.readline()
     if not l:
         return None
     l = l.strip()
-    if l[0] == ';':
+    if l[0].isdigit():
-        return read_line(fd)
+        return parse_data(l, state)
-    return [float(x) for x in filter(None, l.split(' '))]
+    else:
+        return parse_event(l, state)
 
 def read_data(fd):
-    data = []
+    state = {'data':[],
-    l = read_line(fd)
+             'packet-sent':[],
-    while l:
+             'packet-lost':[],
-        data.append(l)
+             'packet-received':[],
-        l = read_line(fd)
+             'packet-observed':[]}
-    return data
+    newstate = state
+    while newstate:
+        state = newstate
+        newstate = read_line(fd, state)
+    return state
 
 def make_xticks(start, end, numticks):
     return range(int(start), int(end), int((start-end)/numticks))
@@ -29,11 +47,24 @@ def make_xticks(start, end, numticks):
 def make_plot(title):
     l = sys.stdin.readline()
     labels = l.strip().split(';')
-    data = read_data(sys.stdin)
+    state = read_data(sys.stdin)
+    data = state['data']
+    lost_packets = state['packet-lost']
+    obsv_packets = state['packet-observed']
+    sent_packets = state['packet-sent']
+    recd_packets = state['packet-received']
 
     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.plot([x[0] for x in lost_packets], [x[1] for x in lost_packets],
+               label='Client sent packet, but dropped', marker='x', linestyle=None, ms=8)
+    pylab.plot([x[0] for x in sent_packets], [x[1] for x in sent_packets],
+               label='Client sent packet', marker='^', linestyle=None, ms=8)
+    pylab.plot([x[0] for x in obsv_packets], [x[1] for x in obsv_packets],
+               label='Remote time observation', marker='D', linestyle=None, ms=8)
+    pylab.plot([x[0] for x in recd_packets], [x[1] for x in recd_packets],
+               label='Client received packet', marker='v', linestyle=None, ms=8)
     pylab.legend()
     pylab.ylabel(r'Clock time (s)')
     pylab.xlabel(r'Real time (s)')

tests/network-clock-utils.scm

@@ -62,6 +62,13 @@
 (define (sq x)
   (* x x))
 
+(define (debug str . args)
+  (if *debug*
+      (apply format (current-error-port) str args)))
+
+(define (print-event kind x y)
+  (format #t "~a ~a ~a\n" kind x y))
+
 ;; Linear least squares.
 ;;
 ;; See http://mathworld.wolfram.com/LeastSquaresFitting.html

tests/network-clock.scm

@@ -1,6 +1,6 @@
 #!/bin/bash
 # -*- scheme -*-
-exec guile -l $0 -e main -- "$@"
+exec guile --debug -l $0 -e main -- "$@"
 !#
 
 ;; GStreamer
@@ -71,31 +71,25 @@ exec guile -l $0 -e main -- "$@"
   (iround (* t *sample-frequency*)))
 
 
-(define (schedule-event events e time loss-probability)
+(define (schedule-event events e time)
   (let lp ((response-time (time->samples time))
            (stream events))
     (if (zero? response-time)
         (if (not (stream-car stream))
-            (if (< (random 1.0) loss-probability)
+            (stream-cons e (stream-cdr stream))
-                stream ;; drop the event
-                (stream-cons e (stream-cdr stream)))
             (stream-cons (stream-car stream) (lp 0 (stream-cdr stream))))
         (stream-cons (stream-car stream) (lp (1- response-time) (stream-cdr stream))))))
 
 (define (schedule-send-time-query events time)
-  (schedule-event events (list 'send-time-query) time 0.0))
+  (schedule-event events (list 'send-time-query) time))
 
 (define (schedule-time-query events l)
   (schedule-event events (list 'time-query l)
-                  (+ *send-delay* (random *send-jitter*)) *send-loss*))
+                  (+ *send-delay* (random *send-jitter*))))
 
 (define (schedule-time-response events l r)
   (schedule-event events (list 'time-response l r)
-                  (+ *recv-delay* (random *recv-jitter*)) *recv-loss*))
+                  (+ *recv-delay* (random *recv-jitter*))))
-
-
-(define (timeout-- t)
-  (- t (/ 1 *sample-frequency*)))
 
 (define (network-time remote-time local-time events m b x y t)
   (let ((r (stream-car remote-time))
@@ -111,12 +105,19 @@ exec guile -l $0 -e main -- "$@"
 
     (case (and=> event car)
       ((send-time-query)
-       (format #t "; sending time query: ~a\n" l)
+       (cond
-       (next (schedule-time-query events l) m b x y *timeout*))
+        ((< (random 1.0) *packet-loss*)
+         (debug "; dropped time query: ~a\n" l)
+         (print-event 'packet-lost l (+ (* m l) b))
+         (next events m b x y (time->samples *timeout*)))
+        (else
+         (debug "; sending time query: ~a\n" l)
+         (print-event 'packet-sent l (+ (* m l) b))
+         (next (schedule-time-query events l) m b x y (time->samples *timeout*)))))
 
       ((time-query)
-       (format #t "; time query received, replying with ~a\n" r)
+       (debug "; time query received, replying with ~a\n" r)
-       (next (schedule-time-response events (cadr event) r) m b x y (timeout-- t)))
+       (next (schedule-time-response events (cadr event) r) m b x y (and t (1- t))))
 
       ((time-response)
        (let ((x (q-push x (avg (cadr event) l)))
@@ -130,7 +131,9 @@ exec guile -l $0 -e main -- "$@"
                     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)
+             (debug "; new slope and offset: ~a ~a (~a)\n" m b r-squared)
+             (print-event 'packet-observed (avg (cadr event) l) (caddr event))
+             (print-event 'packet-received l (+ (* m l) b))
              (next (schedule-send-time-query events (next-time)) m b x y #f)))))
 
       (else
@@ -138,11 +141,11 @@ exec guile -l $0 -e main -- "$@"
         ((not t)
          ;; not waiting for a response
          (next events m b x y t))
-        ((<= t 0.0)
+        ((<= t 0)
          ;; we timed out
-         (next (schedule-send-time-query events 0.0) m b x y 0.0))
+         (next (schedule-send-time-query events 0.0) m b x y 0))
         (else
-         (next events m b x y (timeout-- t))))))))
+         (next events m b x y (1- t))))))))
 
 (define (run-simulation remote-speed local-speed)
   (let ((absolute-time (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
@@ -163,30 +166,28 @@ exec guile -l $0 -e main -- "$@"
         (make-q (list (stream-car remote-time)))
         #f)))))
 
-(define (print-simulation total-time sample-rate remote-speed local-speed)
+(define (print-simulation)
   (display "Absolute time; Remote time; Local time; Network time\n")
   (call-with-values
-      (lambda () (run-simulation remote-speed local-speed))
+      (lambda () (run-simulation *remote-rate* *local-rate*))
     (lambda streams
       (apply
        stream-while
-       (lambda (a r l n) (<= a total-time))
+       (lambda (a r l n) (<= a *total-time*))
        (lambda (a r l n) (format #t "~a ~a ~a ~a\n" a r l n))
        streams))))
 
 (define (plot-simulation)
   (let ((port (open-output-pipe "./plot-data Network Clock Simulation")))
     (with-output-to-port port
-      (lambda ()
+      print-simulation)
-        (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 *recv-delay* 0.1)
-(define-parameter *send-loss* 0.02)
+(define-parameter *packet-loss* 0.01)
-(define-parameter *recv-loss* 0.02)
 (define-parameter *send-jitter* 0.1)
 (define-parameter *recv-jitter* 0.1)
 (define-parameter *queue-length* 32)
@@ -194,9 +195,13 @@ exec guile -l $0 -e main -- "$@"
 (define-parameter *remote-rate* 1.1)
 (define-parameter *total-time* 5.0)
 (define-parameter *timeout* 1.0)
+(define-parameter *debug* #f)
+(define-parameter *with-graph* #t)
 
 
 (define (main args)
   (parse-parameter-arguments (cdr args))
-  (plot-simulation)
+  (if *with-graph*
+      (plot-simulation)
+      (print-simulation))
   (quit))

tests/plot-data

@@ -6,22 +6,40 @@ import pylab
 import optparse
 import sys
 
-def read_line(fd):
+def parse_data(l, state):
+    state['data'].append([float(x) for x in filter(None, l.split(' '))])
+    return state
+
+def parse_event(l, state):
+    components = filter(None, l.split(' '))
+    vals = [float(x) for x in components[1:]]
+    if not components[0] in state:
+        state[components[0]] = [vals]
+    else:
+        state[components[0]].append(vals)
+    return state
+
+def read_line(fd, state):
     l = fd.readline()
     if not l:
         return None
     l = l.strip()
-    if l[0] == ';':
+    if l[0].isdigit():
-        return read_line(fd)
+        return parse_data(l, state)
-    return [float(x) for x in filter(None, l.split(' '))]
+    else:
+        return parse_event(l, state)
 
 def read_data(fd):
-    data = []
+    state = {'data':[],
-    l = read_line(fd)
+             'packet-sent':[],
-    while l:
+             'packet-lost':[],
-        data.append(l)
+             'packet-received':[],
-        l = read_line(fd)
+             'packet-observed':[]}
-    return data
+    newstate = state
+    while newstate:
+        state = newstate
+        newstate = read_line(fd, state)
+    return state
 
 def make_xticks(start, end, numticks):
     return range(int(start), int(end), int((start-end)/numticks))
@@ -29,11 +47,24 @@ def make_xticks(start, end, numticks):
 def make_plot(title):
     l = sys.stdin.readline()
     labels = l.strip().split(';')
-    data = read_data(sys.stdin)
+    state = read_data(sys.stdin)
+    data = state['data']
+    lost_packets = state['packet-lost']
+    obsv_packets = state['packet-observed']
+    sent_packets = state['packet-sent']
+    recd_packets = state['packet-received']
 
     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.plot([x[0] for x in lost_packets], [x[1] for x in lost_packets],
+               label='Client sent packet, but dropped', marker='x', linestyle=None, ms=8)
+    pylab.plot([x[0] for x in sent_packets], [x[1] for x in sent_packets],
+               label='Client sent packet', marker='^', linestyle=None, ms=8)
+    pylab.plot([x[0] for x in obsv_packets], [x[1] for x in obsv_packets],
+               label='Remote time observation', marker='D', linestyle=None, ms=8)
+    pylab.plot([x[0] for x in recd_packets], [x[1] for x in recd_packets],
+               label='Client received packet', marker='v', linestyle=None, ms=8)
     pylab.legend()
     pylab.ylabel(r'Clock time (s)')
     pylab.xlabel(r'Real time (s)')