+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:
(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
#!/bin/bash
# -*- scheme -*-
-exec guile -l $0 -e main -- "$@"
+exec guile --debug -l $0 -e main -- "$@"
!#
;; GStreamer
(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 ;; drop the event
- (stream-cons e (stream-cdr stream)))
+ (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*))
-
-
-(define (timeout-- t)
- (- t (/ 1 *sample-frequency*)))
+ (+ *recv-delay* (random *recv-jitter*))))
(define (network-time remote-time local-time events m b x y t)
(let ((r (stream-car remote-time))
(case (and=> event car)
((send-time-query)
- (format #t "; sending time query: ~a\n" l)
- (next (schedule-time-query events l) m b x y *timeout*))
+ (cond
+ ((< (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)
- (next (schedule-time-response events (cadr event) r) m b x y (timeout-- t)))
+ (debug "; time query received, replying with ~a\n" r)
+ (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)))
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
((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*)))
(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 *total-time* #f *remote-rate* *local-rate*)))
+ print-simulation)
(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 *recv-loss* 0.02)
+(define-parameter *packet-loss* 0.01)
(define-parameter *send-jitter* 0.1)
(define-parameter *recv-jitter* 0.1)
(define-parameter *queue-length* 32)
(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))
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] == ';':
- return read_line(fd)
- return [float(x) for x in filter(None, l.split(' '))]
+ if l[0].isdigit():
+ return parse_data(l, state)
+ else:
+ return parse_event(l, state)
def read_data(fd):
- data = []
- l = read_line(fd)
- while l:
- data.append(l)
- l = read_line(fd)
- return data
+ state = {'data':[],
+ 'packet-sent':[],
+ 'packet-lost':[],
+ 'packet-received':[],
+ 'packet-observed':[]}
+ 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))
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)')
(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
#!/bin/bash
# -*- scheme -*-
-exec guile -l $0 -e main -- "$@"
+exec guile --debug -l $0 -e main -- "$@"
!#
;; GStreamer
(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 ;; drop the event
- (stream-cons e (stream-cdr stream)))
+ (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*))
-
-
-(define (timeout-- t)
- (- t (/ 1 *sample-frequency*)))
+ (+ *recv-delay* (random *recv-jitter*))))
(define (network-time remote-time local-time events m b x y t)
(let ((r (stream-car remote-time))
(case (and=> event car)
((send-time-query)
- (format #t "; sending time query: ~a\n" l)
- (next (schedule-time-query events l) m b x y *timeout*))
+ (cond
+ ((< (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)
- (next (schedule-time-response events (cadr event) r) m b x y (timeout-- t)))
+ (debug "; time query received, replying with ~a\n" r)
+ (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)))
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
((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*)))
(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 *total-time* #f *remote-rate* *local-rate*)))
+ print-simulation)
(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 *recv-loss* 0.02)
+(define-parameter *packet-loss* 0.01)
(define-parameter *send-jitter* 0.1)
(define-parameter *recv-jitter* 0.1)
(define-parameter *queue-length* 32)
(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))
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] == ';':
- return read_line(fd)
- return [float(x) for x in filter(None, l.split(' '))]
+ if l[0].isdigit():
+ return parse_data(l, state)
+ else:
+ return parse_event(l, state)
def read_data(fd):
- data = []
- l = read_line(fd)
- while l:
- data.append(l)
- l = read_line(fd)
- return data
+ state = {'data':[],
+ 'packet-sent':[],
+ 'packet-lost':[],
+ 'packet-received':[],
+ 'packet-observed':[]}
+ 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))
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)')
projects / platform / upstream / gstreamer.git / commitdiff