source: project/release/4/srfi-27/trunk/tests/srfi-27-test.scm @ 34967

Last change on this file since 34967 was 34967, checked in by kon, 18 months ago

a mission needs support . common test runner .

File size: 7.2 KB
Line 
1;;;; srfi-27-test.scm
2;;;; Kon Lovett, Dec '17
3
4(use test)
5
6;;;
7
8;FIXME real tests
9
10;;
11
12(use srfi-27)
13
14;;;
15
16(print "*** Original Tests ***")
17
18(use utils)
19
20(system* "csi -n -s test-mrg32k3a.scm")
21(system* "csi -n -s test-confidence")
22;(system* "csi -n -s test-diehard") ;errors
23
24;;;
25
26;;
27
28(define-constant SRFI-27-TEST-TITLE "SRFI 27 Extensions")
29
30(test-begin SRFI-27-TEST-TITLE)
31
32;
33
34(use (srfi 1) (srfi 4) data-structures)
35
36;
37
38(use random-source entropy-source)
39
40(test-group "basics entropy"
41  (test-assert (entropy-source? (current-entropy-source)))
42  (test-assert (->string (entropy-source-kind (current-entropy-source))) #t)
43)
44
45(test-group "basics random"
46  (test-assert (random-source? default-random-source))
47  (test-assert (random-source? (current-random-source)))
48  (test-assert (->string (random-source-kind (current-random-source))) #t)
49  (test-assert (procedure? random-integer))
50  (test-assert (procedure? random-real))
51)
52
53;
54
55(test-group "SRFI-4 vector"
56
57  (test-group "u8vector"
58    ;(test-assert (procedure? random-u8vector))
59    (let ((v10 (random-u8vector 10)))
60      (test-assert (u8vector? v10))
61      (test 10 (u8vector-length v10)) ) )
62
63  (test-group "f64vector"
64    ;(test-assert (procedure? random-f64vector))
65    (let ((v10 (random-f64vector 10)))
66      (test-assert (f64vector? v10))
67      (test 10 (f64vector-length v10)) ) )
68)
69
70;
71
72(use srfi-27-uniform-random)
73
74(test-group "uniform-random"
75
76  (test-group "integers"
77    (let-values (
78        ((gen init)
79          (make-uniform-random-integers high: 27 low: 16 precision: 2)))
80      (let-values (((high low precision source) (init)))
81        (test-assert (= 27 high))
82        (test-assert (= 16 low))
83        (test-assert (= 2 precision))
84        (do ((i 0 (add1 i))
85             (rv (gen) (gen)) )
86            ((= 100 i))
87          (unless (<= 16 rv) (test-assert (<= 16 rv)))
88          (unless (<= rv 27) (test-assert (<= rv 27)))
89          (unless (zero? (modulo rv 2)) (test-assert (zero? (modulo rv 2)))) ) ) ) )
90
91  ;FIXME needs real test
92  (test-group "reals"
93    (let-values (
94        ((gen init)
95          (make-uniform-random-reals precision: 0.000000000003)))
96      (let-values (((precision source) (init)))
97        (test-assert (= 0.000000000003 precision))
98        ;(flonum-print-precision 53)
99        (do ((i 0 (add1 i))
100             (rv (gen) (gen)) )
101            ((= 100 i))
102            ) ) ) )
103)
104
105; Vectors
106
107(use srfi-27-vector)
108
109(define-constant VECTOR-LENGTH-LIMIT 10)
110(define-constant VECTOR-EXAMPLES-LIMIT 3)
111
112(define +known-vectors+  `(
113  (,make-random-permutations ,integer? "permutations")
114  (,make-random-vector ,real? "vector")
115  (,make-random-hollow-sphere ,real? "hollow-sphere")
116  (,make-random-solid-sphere ,real? "solid-sphere")
117))
118
119(test-group "vector"
120  (for-each
121    (lambda (vect-data)
122      (let ((vect-ctor (car vect-data))
123            (vect-pred (cadr vect-data))
124            (vect-name (caddr vect-data)) )
125        (test-group vect-name
126          (let* ((ctor (vect-ctor))
127                 (vec (ctor VECTOR-LENGTH-LIMIT)) )
128            (test-assert "collection" (vector? vec))
129            ;(test-assert "elements" (every vect-pred (vector->list vec)))
130            (test "constructed length" VECTOR-LENGTH-LIMIT (vector-length vec))
131            (do ((i 1 (add1 i)))
132                ((> i VECTOR-EXAMPLES-LIMIT))
133              (let ((res (vector-ref vec i)))
134                (test-assert (->string res) (vect-pred res)) ) ) ) ) ) )
135    +known-vectors+)
136)
137
138; Distributions
139
140(use srfi-27-distributions)
141
142(define-constant DISTRIBUTION-EXAMPLES-LIMIT 3)
143
144(define +known-distributions+  `(
145  (,make-random-normals ,real? "normals")
146  (,make-random-exponentials ,real? "exponentials")
147  (,make-random-triangles ,real? "triangles")
148  (,make-random-poissons ,integer? "poissons")
149  (,make-random-bernoullis ,boolean? "bernoullis")
150  (,make-random-binomials ,integer? "binomials")
151  (,make-random-geometrics ,integer? "geometrics")
152  (,make-random-lognormals ,real? "lognormals")
153  (,make-random-cauchys ,real? "cauchys")
154  (,make-random-gammas ,real? "gammas")
155  (,make-random-erlangs ,real? "erlangs")
156  (,make-random-paretos ,real? "paretos")
157  (,make-random-levys ,real? "levys")
158  (,make-random-weibulls ,real? "weibulls")
159))
160
161(test-group "distributions"
162  (for-each
163    (lambda (distr-data)
164      (let ((distr-ctor (car distr-data))
165            (distr-pred (cadr distr-data))
166            (distr-name (caddr distr-data)) )
167        (test-group distr-name
168          (receive (genny params) (distr-ctor)
169            (test-assert "generator" (procedure? genny))
170            (test-assert "parameters" (procedure? params))
171            #; ;PLIST-STYLE (CLOJURE?)
172            (with (param-list (call-with-values params list))
173              (test-assert (->string param-list) (list? param-list)) )
174            (let ((param-list (call-with-values params list)))
175              (test-assert (->string param-list) (list? param-list)) )
176            (do ((i 1 (add1 i)))
177                ((> i DISTRIBUTION-EXAMPLES-LIMIT))
178              (let ((res (genny)))
179                (test-assert (->string res) (distr-pred res)) ) ) ) ) ) )
180    +known-distributions+)
181)
182
183; Composite Entropy (experimental - at best)
184
185(use entropy-clock)
186
187(use composite-entropy-source)
188
189(cond-expand
190  (windows
191    (use entropy-windows) )
192  (unix
193    (use entropy-unix) ) )
194
195;FIXME use entropy name
196(define-constant COMPOSITE-ENTROPY-TITLE
197  (string-append
198    "composite entropy : "
199    (cond-expand
200      (windows
201        "crypt" )
202      (unix
203        (string-append "random-device" " + " "urandom-device")))))
204
205(test-group COMPOSITE-ENTROPY-TITLE
206  (let* ((ces-ctor
207          (composite-entropy-source
208            (make-entropy-source-system-clock)
209            (cond-expand
210              (windows
211                (make-entropy-source-crypt) )
212              (unix
213                (make-entropy-source-random-device)
214                (make-entropy-source-urandom-device) ) ) ) )
215         (ces (ces-ctor) )
216         (genu8 (entropy-source-u8 ces) )
217         (genf64 (entropy-source-f64 ces) ) )
218    (test-assert (integer? (genu8)))
219    (test-assert (<= 0 (genu8)))
220    (test-assert (<= (genu8) 255))
221    (test-assert (flonum? (genf64)))
222    (test-assert (u8vector? (entropy-source-u8vector ces 2)))
223    (test-assert (= 2 (u8vector-length (entropy-source-u8vector ces 2))))
224    (test-assert (f64vector? (entropy-source-f64vector ces 2)))
225    (test-assert (= 2 (f64vector-length (entropy-source-f64vector ces 2))))
226  )
227)
228
229; Composite Random (experimental - at best)
230
231(use composite-random-source)
232(use mwc mrg32k3a moa)
233
234;FIXME use random name
235(test-group "composite random : mwc + mrg32k3a + moa"
236  (let* ((crs-ctor
237          (composite-random-source
238            (make-random-source-mwc)
239            (make-random-source-mrg32k3a)
240            (make-random-source-moa)) )
241         (crs (crs-ctor) )
242         (rndint (random-source-make-integers crs) )
243         (rnd (random-source-make-reals crs) ) )
244    (test-assert (procedure? rndint))
245    (test-assert (procedure? rnd))
246    (test-assert (integer? (rndint 10)))
247    (test-assert (<= 0 (rndint 10)))
248    (test-assert (<= (rndint 10) 10))
249    (test-assert (inexact? (rnd)))
250    (test-assert (random-source-randomize! crs))
251    (test-assert (random-source-pseudo-randomize! crs 1 2))
252  )
253)
254
255;;
256
257(test-end SRFI-27-TEST-TITLE)
258
259;;;
260
261(test-exit)
Note: See TracBrowser for help on using the repository browser.