+2005-06-23 Andy Wingo <wingo@pobox.com>
+
+ * tests/network-clock.scm:
+ * tests/network-clock-utils.scm: A network clock simulator.
+ Something of an algorithmic testbed before doing something in C.
+
2005-06-22 Thomas Vander Stichele <thomas at apestaart dot org>
* check/Makefile.am:
--- /dev/null
+;; GStreamer
+;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
+;; Boston, MA 02111-1307, USA gnu@gnu.org
+
+
+;;; Commentary:
+;;
+;; Utilities for the network clock simulator.
+;;
+;;; Code:
+
+
+;; General utilities.
+
+(define (iround x)
+ (if (inexact? x)
+ (inexact->exact (round x))
+ x))
+
+(define (filter proc l)
+ (cond
+ ((null? l) '())
+ ((proc (car l)) (cons (car l) (filter proc (cdr l))))
+ (else (filter proc (cdr l)))))
+
+(define (sum l)
+ (apply + l))
+
+(define (avg . nums)
+ (/ (sum nums) (length nums)))
+
+(define (sq x)
+ (* x x))
+
+;; Linear least squares.
+;;
+;; See http://mathworld.wolfram.com/LeastSquaresFitting.html
+;; returns (values slope intercept r-squared)
+
+(define (least-squares x y)
+ (let ((n (length x)))
+ (let ((xbar (apply avg x))
+ (ybar (apply avg y)))
+ (let ((sxx (- (sum (map sq x)) (* n (sq xbar))))
+ (syy (- (sum (map sq y)) (* n (sq ybar))))
+ (sxy (- (sum (map * x y)) (* n xbar ybar))))
+ (let ((slope (/ sxy sxx)))
+ (values
+ slope
+ (- ybar (* slope xbar))
+ (/ (sq sxy) (* sxx syy))))))))
+
+;; Streams: lists with lazy cdrs.
+
+(define-macro (stream-cons kar kdr)
+ `(cons ,kar (delay ,kdr)))
+
+(define (stream-cdr stream)
+ (force (cdr stream)))
+
+(define (stream-car stream)
+ (car stream))
+
+(define (stream-null? stream)
+ (null? stream))
+
+(define (stream-ref stream n)
+ (if (zero? n)
+ (stream-car stream)
+ (stream-ref (stream-cdr stream) (1- n))))
+
+(define (stream->list stream n)
+ (let lp ((in stream) (out '()) (n n))
+ (if (zero? n)
+ (reverse! out)
+ (lp (stream-cdr in) (cons (stream-car in) out) (1- n)))))
+
+(define (stream-skip stream n)
+ (if (zero? n)
+ stream
+ (stream-skip (stream-cdr stream) (1- n))))
+
+(define (stream-sample stream n)
+ (stream-cons (stream-car stream)
+ (stream-sample (stream-skip stream n) n)))
+
+(define (stream-map proc . streams)
+ (stream-cons (apply proc (map stream-car streams))
+ (apply stream-map proc (map stream-cdr streams))))
+
+(define (arithmetic-series start step)
+ (stream-cons start (arithmetic-series (+ start step) step)))
+
+(define (scale-stream stream factor)
+ (stream-map (lambda (t) (* t factor)) *absolute-time*))
+
+(define (stream-while pred proc . streams)
+ (if (apply pred (map stream-car streams))
+ (begin
+ (apply proc (map stream-car streams))
+ (apply stream-while pred proc (map stream-cdr streams)))))
+
+(define (stream-of val)
+ (stream-cons val (stream-of val)))
+
+(define (periodic-stream val period)
+ (let ((period (iround (max 1 (* *sample-frequency* period)))))
+ (let lp ((n 0))
+ (if (zero? n)
+ (stream-cons val (lp period))
+ (stream-cons #f (lp (1- n)))))))
+
+
+;; Queues with a maximum length.
+
+(define *q-length* 32)
+
+(define (make-q l)
+ (cons l (last-pair l)))
+
+(define (q-head q)
+ (car q))
+
+(define (q-tail q)
+ (car q))
+
+(define (q-push q val)
+ (let ((tail (cons val '())))
+ (if (null? (q-tail q))
+ (make-q tail)
+ (let ((l (append! (q-head q) tail)))
+ (if (> (length (q-head q)) *q-length*)
+ (make-q (cdr (q-head q)))
+ q)))))
--- /dev/null
+#!/bin/bash
+# -*- scheme -*-
+exec guile -l $0 -e main "$@"
+!#
+
+;; GStreamer
+;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
+;; Boston, MA 02111-1307, USA gnu@gnu.org
+
+
+;;; Commentary:
+;;
+;; Network clock simulator.
+;;
+;; Simulates the attempts of one clock to synchronize with another over
+;; the network. Packets are sent out with a local timestamp, and come
+;; back with the remote time added on to the packet. The remote time is
+;; assumed to have been observed at the local time in between sending
+;; the query and receiving the reply.
+;;
+;; The local clock will attempt to adjust its rate and offset by fitting
+;; a line to the last N datapoints on hand, by default 32. A better fit,
+;; as measured by the correlation coefficient, will result in a longer
+;; time before the next query. Bad fits or a not-yet-full set of data
+;; will result in many queries in quick succession.
+;;
+;; The rate and offset are set directly to the slope and intercept from
+;; the linear regression. This results in discontinuities in the local
+;; time. As clock times must be monotonically increasing, a jump down in
+;; time will result instead in time standing still for a while. Smoothly
+;; varying the rate such that no discontinuities are present has not
+;; been investigated.
+;;
+;; Implementation-wise, this simulator processes events and calculates
+;; times discretely. Times are represented as streams, also known as
+;; lazy lists. This is an almost-pure functional simulator. The thing to
+;; remember while reading is that stream-cons does not evaluate its
+;; second argument, rather deferring that calculation until stream-cdr
+;; 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.
+;;
+;;; Code:
+
+
+(use-modules (ice-9 slib))
+(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))
+ (stream events))
+ (if (zero? response-time)
+ (if (not (stream-car 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))
+
+(define (schedule-time-query events l)
+ (schedule-event events (list 'time-query l) (+ 0.20 (random 0.20))))
+
+(define (schedule-time-response events l r)
+ (schedule-event events (list 'time-response l r) (+ 0.20 (random 0.20))))
+
+(define (network-time remote-time local-time events m b x y)
+ (let ((r (stream-car remote-time))
+ (l (stream-car local-time))
+ (event (stream-car events))
+ (events (stream-cdr events)))
+
+ (define (next events m b x y)
+ (stream-cons
+ (+ (* m l) b)
+ (network-time
+ (stream-cdr remote-time) (stream-cdr local-time) events m b x y)))
+
+ (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))
+
+ ((time-query)
+ (format #t "time query received, replying with ~a\n" r)
+ (next (schedule-time-response events (cadr event) r) m b x y))
+
+ ((time-response)
+ (let ((x (q-push x (avg (cadr event) l)))
+ (y (q-push y (caddr event))))
+ (call-with-values
+ (lambda () (least-squares (q-head x) (q-head y)))
+ (lambda (m b r-squared)
+ (define (next-time)
+ (max
+ (if (< (length (q-head x)) *q-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)
+ (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)))))))
+
+(define (print-simulation total-time sample-rate remote-speed local-speed)
+ (display ";; absolute remote local network\n")
+ (call-with-values
+ (lambda () (run-simulation remote-speed local-speed))
+ (lambda streams
+ (apply
+ stream-while
+ (lambda (a r l n) (<= a total-time))
+ (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))
--- /dev/null
+;; GStreamer
+;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
+;; Boston, MA 02111-1307, USA gnu@gnu.org
+
+
+;;; Commentary:
+;;
+;; Utilities for the network clock simulator.
+;;
+;;; Code:
+
+
+;; General utilities.
+
+(define (iround x)
+ (if (inexact? x)
+ (inexact->exact (round x))
+ x))
+
+(define (filter proc l)
+ (cond
+ ((null? l) '())
+ ((proc (car l)) (cons (car l) (filter proc (cdr l))))
+ (else (filter proc (cdr l)))))
+
+(define (sum l)
+ (apply + l))
+
+(define (avg . nums)
+ (/ (sum nums) (length nums)))
+
+(define (sq x)
+ (* x x))
+
+;; Linear least squares.
+;;
+;; See http://mathworld.wolfram.com/LeastSquaresFitting.html
+;; returns (values slope intercept r-squared)
+
+(define (least-squares x y)
+ (let ((n (length x)))
+ (let ((xbar (apply avg x))
+ (ybar (apply avg y)))
+ (let ((sxx (- (sum (map sq x)) (* n (sq xbar))))
+ (syy (- (sum (map sq y)) (* n (sq ybar))))
+ (sxy (- (sum (map * x y)) (* n xbar ybar))))
+ (let ((slope (/ sxy sxx)))
+ (values
+ slope
+ (- ybar (* slope xbar))
+ (/ (sq sxy) (* sxx syy))))))))
+
+;; Streams: lists with lazy cdrs.
+
+(define-macro (stream-cons kar kdr)
+ `(cons ,kar (delay ,kdr)))
+
+(define (stream-cdr stream)
+ (force (cdr stream)))
+
+(define (stream-car stream)
+ (car stream))
+
+(define (stream-null? stream)
+ (null? stream))
+
+(define (stream-ref stream n)
+ (if (zero? n)
+ (stream-car stream)
+ (stream-ref (stream-cdr stream) (1- n))))
+
+(define (stream->list stream n)
+ (let lp ((in stream) (out '()) (n n))
+ (if (zero? n)
+ (reverse! out)
+ (lp (stream-cdr in) (cons (stream-car in) out) (1- n)))))
+
+(define (stream-skip stream n)
+ (if (zero? n)
+ stream
+ (stream-skip (stream-cdr stream) (1- n))))
+
+(define (stream-sample stream n)
+ (stream-cons (stream-car stream)
+ (stream-sample (stream-skip stream n) n)))
+
+(define (stream-map proc . streams)
+ (stream-cons (apply proc (map stream-car streams))
+ (apply stream-map proc (map stream-cdr streams))))
+
+(define (arithmetic-series start step)
+ (stream-cons start (arithmetic-series (+ start step) step)))
+
+(define (scale-stream stream factor)
+ (stream-map (lambda (t) (* t factor)) *absolute-time*))
+
+(define (stream-while pred proc . streams)
+ (if (apply pred (map stream-car streams))
+ (begin
+ (apply proc (map stream-car streams))
+ (apply stream-while pred proc (map stream-cdr streams)))))
+
+(define (stream-of val)
+ (stream-cons val (stream-of val)))
+
+(define (periodic-stream val period)
+ (let ((period (iround (max 1 (* *sample-frequency* period)))))
+ (let lp ((n 0))
+ (if (zero? n)
+ (stream-cons val (lp period))
+ (stream-cons #f (lp (1- n)))))))
+
+
+;; Queues with a maximum length.
+
+(define *q-length* 32)
+
+(define (make-q l)
+ (cons l (last-pair l)))
+
+(define (q-head q)
+ (car q))
+
+(define (q-tail q)
+ (car q))
+
+(define (q-push q val)
+ (let ((tail (cons val '())))
+ (if (null? (q-tail q))
+ (make-q tail)
+ (let ((l (append! (q-head q) tail)))
+ (if (> (length (q-head q)) *q-length*)
+ (make-q (cdr (q-head q)))
+ q)))))
--- /dev/null
+#!/bin/bash
+# -*- scheme -*-
+exec guile -l $0 -e main "$@"
+!#
+
+;; GStreamer
+;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
+;; Boston, MA 02111-1307, USA gnu@gnu.org
+
+
+;;; Commentary:
+;;
+;; Network clock simulator.
+;;
+;; Simulates the attempts of one clock to synchronize with another over
+;; the network. Packets are sent out with a local timestamp, and come
+;; back with the remote time added on to the packet. The remote time is
+;; assumed to have been observed at the local time in between sending
+;; the query and receiving the reply.
+;;
+;; The local clock will attempt to adjust its rate and offset by fitting
+;; a line to the last N datapoints on hand, by default 32. A better fit,
+;; as measured by the correlation coefficient, will result in a longer
+;; time before the next query. Bad fits or a not-yet-full set of data
+;; will result in many queries in quick succession.
+;;
+;; The rate and offset are set directly to the slope and intercept from
+;; the linear regression. This results in discontinuities in the local
+;; time. As clock times must be monotonically increasing, a jump down in
+;; time will result instead in time standing still for a while. Smoothly
+;; varying the rate such that no discontinuities are present has not
+;; been investigated.
+;;
+;; Implementation-wise, this simulator processes events and calculates
+;; times discretely. Times are represented as streams, also known as
+;; lazy lists. This is an almost-pure functional simulator. The thing to
+;; remember while reading is that stream-cons does not evaluate its
+;; second argument, rather deferring that calculation until stream-cdr
+;; 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.
+;;
+;;; Code:
+
+
+(use-modules (ice-9 slib))
+(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))
+ (stream events))
+ (if (zero? response-time)
+ (if (not (stream-car 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))
+
+(define (schedule-time-query events l)
+ (schedule-event events (list 'time-query l) (+ 0.20 (random 0.20))))
+
+(define (schedule-time-response events l r)
+ (schedule-event events (list 'time-response l r) (+ 0.20 (random 0.20))))
+
+(define (network-time remote-time local-time events m b x y)
+ (let ((r (stream-car remote-time))
+ (l (stream-car local-time))
+ (event (stream-car events))
+ (events (stream-cdr events)))
+
+ (define (next events m b x y)
+ (stream-cons
+ (+ (* m l) b)
+ (network-time
+ (stream-cdr remote-time) (stream-cdr local-time) events m b x y)))
+
+ (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))
+
+ ((time-query)
+ (format #t "time query received, replying with ~a\n" r)
+ (next (schedule-time-response events (cadr event) r) m b x y))
+
+ ((time-response)
+ (let ((x (q-push x (avg (cadr event) l)))
+ (y (q-push y (caddr event))))
+ (call-with-values
+ (lambda () (least-squares (q-head x) (q-head y)))
+ (lambda (m b r-squared)
+ (define (next-time)
+ (max
+ (if (< (length (q-head x)) *q-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)
+ (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)))))))
+
+(define (print-simulation total-time sample-rate remote-speed local-speed)
+ (display ";; absolute remote local network\n")
+ (call-with-values
+ (lambda () (run-simulation remote-speed local-speed))
+ (lambda streams
+ (apply
+ stream-while
+ (lambda (a r l n) (<= a total-time))
+ (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))