• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1;; GStreamer
2;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
3
4;; This program is free software; you can redistribute it and/or
5;; modify it under the terms of the GNU General Public License as
6;; published by the Free Software Foundation; either version 2 of
7;; the License, or (at your option) any later version.
8;;
9;; This program is distributed in the hope that it will be useful,
10;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12;; GNU General Public License for more details.
13;;
14;; You should have received a copy of the GNU General Public License
15;; along with this program; if not, contact:
16;;
17;; Free Software Foundation           Voice:  +1-617-542-5942
18;; 51 Franklin St, Fifth Floor        Fax:    +1-617-542-2652
19;; Boston, MA  02110-1301,  USA       gnu@gnu.org
20
21
22;;; Commentary:
23;;
24;; Utilities for the network clock simulator.
25;;
26;;; Code:
27
28
29;; Init the rng.
30
31(use-modules ((srfi srfi-1) (fold unfold)))
32
33(define (read-bytes-from-file-as-integer f n)
34  (with-input-from-file f
35    (lambda ()
36      (fold (lambda (x seed) (+ x (ash seed 8)))
37            0
38            (unfold zero? (lambda (n) (char->integer (read-char))) 1- n)))))
39
40(set! *random-state* (seed->random-state
41                      (read-bytes-from-file-as-integer "/dev/random" 4)))
42
43;; General utilities.
44
45(define (iround x)
46  (if (inexact? x)
47      (inexact->exact (round x))
48      x))
49
50(define (filter proc l)
51  (cond
52   ((null? l) '())
53   ((proc (car l)) (cons (car l) (filter proc (cdr l))))
54   (else (filter proc (cdr l)))))
55
56(define (sum l)
57  (apply + l))
58
59(define (avg . nums)
60  (/ (sum nums) (length nums)))
61
62(define (sq x)
63  (* x x))
64
65(define (debug str . args)
66  (if *debug*
67      (apply format (current-error-port) str args)))
68
69(define (print-event kind x y)
70  (format #t "~a ~a ~a\n" kind x y))
71
72;; Linear least squares.
73;;
74;; See http://mathworld.wolfram.com/LeastSquaresFitting.html
75;; returns (values slope intercept r-squared)
76
77(define (least-squares x y)
78  (let ((n (length x)))
79    (let ((xbar (apply avg x))
80          (ybar (apply avg y)))
81      (let ((sxx (- (sum (map sq x)) (* n (sq xbar))))
82            (syy (- (sum (map sq y)) (* n (sq ybar))))
83            (sxy (- (sum (map * x y)) (* n xbar ybar))))
84        (let ((slope (/ sxy sxx)))
85          (values
86           slope
87           (- ybar (* slope xbar))
88           (/ (sq sxy) (* sxx syy))))))))
89
90;; Streams: lists with lazy cdrs.
91
92(define-macro (stream-cons kar kdr)
93  `(cons ,kar (delay ,kdr)))
94
95(define (stream-cdr stream)
96  (force (cdr stream)))
97
98(define (stream-car stream)
99  (car stream))
100
101(define (stream-null? stream)
102  (null? stream))
103
104(define (stream-ref stream n)
105  (if (zero? n)
106      (stream-car stream)
107      (stream-ref (stream-cdr stream) (1- n))))
108
109(define (stream->list stream n)
110  (let lp ((in stream) (out '()) (n n))
111    (if (zero? n)
112        (reverse! out)
113        (lp (stream-cdr in) (cons (stream-car in) out) (1- n)))))
114
115(define (stream-skip stream n)
116  (if (zero? n)
117      stream
118      (stream-skip (stream-cdr stream) (1- n))))
119
120(define (stream-sample stream n)
121  (stream-cons (stream-car stream)
122               (stream-sample (stream-skip stream n) n)))
123
124(define (stream-map proc . streams)
125  (stream-cons (apply proc (map stream-car streams))
126               (apply stream-map proc (map stream-cdr streams))))
127
128(define (arithmetic-series start step)
129  (stream-cons start (arithmetic-series (+ start step) step)))
130
131(define (scale-stream stream factor)
132  (stream-map (lambda (t) (* t factor)) stream))
133
134(define (stream-while pred proc . streams)
135  (if (apply pred (map stream-car streams))
136      (begin
137        (apply proc (map stream-car streams))
138        (apply stream-while pred proc (map stream-cdr streams)))))
139
140(define (stream-of val)
141  (stream-cons val (stream-of val)))
142
143(define (periodic-stream val period)
144  (let ((period (iround (max 1 (* *sample-frequency* period)))))
145    (let lp ((n 0))
146      (if (zero? n)
147          (stream-cons val (lp period))
148          (stream-cons #f (lp (1- n)))))))
149
150
151;; Queues with a maximum length.
152
153(define (make-q l)
154  (cons l (last-pair l)))
155
156(define (q-head q)
157  (car q))
158
159(define (q-tail q)
160  (car q))
161
162(define (q-push q val)
163  (let ((tail (cons val '())))
164    (if (null? (q-tail q))
165        (make-q tail)
166        (let ((l (append! (q-head q) tail)))
167          (if (> (length (q-head q)) *window-size*)
168              (make-q (cdr (q-head q)))
169              q)))))
170
171
172;; Parameters, settable via command line arguments.
173
174(define %parameters '())
175(define-macro (define-parameter name val)
176  (let ((str (symbol->string name)))
177    (or (and (eqv? (string-ref str 0) #\*)
178             (eqv? (string-ref str (1- (string-length str))) #\*))
179        (error "Invalid parameter name" name))
180    (let ((param (string->symbol
181                  (substring str 1 (1- (string-length str)))))
182          (val-sym (gensym)))
183      `(begin
184         (define ,name #f)
185         (let ((,val-sym ,val))
186           (set! ,name ,val-sym)
187           (set! %parameters (cons (cons ',param ,val-sym)
188                                   %parameters)))))))
189(define (set-parameter! name val)
190  (define (symbol-append . args)
191    (string->symbol (apply string-append (map symbol->string args))))
192  (or (assq name %parameters)
193      (error "Unknown parameter" name))
194  (module-set! (current-module) (symbol-append '* name '*) val))
195
196(define (parse-parameter-arguments args)
197  (define (usage)
198    (format #t "Usage: ~a ARG1...\n\n" "network-clock.scm")
199    (for-each
200     (lambda (pair)
201       (format #t "\t--~a=VAL \t(default: ~a)\n" (car pair) (cdr pair)))
202     %parameters))
203  (define (unknown-arg arg)
204    (with-output-to-port (current-error-port)
205      (lambda ()
206        (format #t "\nUnknown argument: ~a\n\n" arg)
207        (usage)
208        (quit))))
209  (define (parse-arguments args)
210    (let lp ((in args) (out '()))
211      (cond
212       ((null? in)
213        (reverse! out))
214       ((not (string=? (substring (car in) 0 2) "--"))
215        (unknown-arg (car in)))
216       (else
217        (let ((divider (or (string-index (car in) #\=)
218                           (unknown-arg (car in)))))
219          (or (> divider 2) (unknown-arg (car in)))
220          (let ((param (string->symbol (substring (car in) 2 divider)))
221                (val (with-input-from-string (substring (car in) (1+ divider))
222                       read)))
223            (lp (cdr in) (acons param val out))))))))
224  (for-each
225   (lambda (pair)
226     (or (false-if-exception
227          (set-parameter! (car pair) (cdr pair)))
228         (unknown-arg (format #f "--~a=~a" (car pair) (cdr pair)))))
229   (parse-arguments args)))
230