mirror of
https://gitlab.freedesktop.org/gstreamer/gstreamer.git
synced 2024-11-25 19:21:06 +00:00
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.
This commit is contained in:
Andy Wingo
parent
fc8cbba41b
commit
8ca9bda671
7 changed files with 176 additions and 78 deletions
12
ChangeLog
12
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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;; 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))
|
||||
|
|
@ -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)
|
||||
(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)))
|
||||
|
|
@ -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 *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)
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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] == ';':
|
||||
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))
|
||||
|
|
@ -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)')
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;; 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))
|
||||
|
|
@ -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)
|
||||
(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)))
|
||||
|
|
@ -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 *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)
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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] == ';':
|
||||
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))
|
||||
|
|
@ -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)')
|
||||
|
|
|
|||
Loading…
Reference in a new issue