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

Last change on this file since 35473 was 35473, checked in by kon, 7 months ago

fix make reals type, add type for clock entropy

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