1 USING: math.intervals kernel sequences words math math.order
2 arrays prettyprint tools.test random vocabs combinators
4 IN: math.intervals.tests
6 [ empty-interval ] [ 2 2 (a,b) ] unit-test
8 [ empty-interval ] [ 2 2 [a,b) ] unit-test
10 [ empty-interval ] [ 2 2 (a,b] ] unit-test
12 [ empty-interval ] [ 3 2 [a,b] ] unit-test
14 [ T{ interval f { 1 t } { 2 t } } ] [ 1 2 [a,b] ] unit-test
16 [ T{ interval f { 1 t } { 2 f } } ] [ 1 2 [a,b) ] unit-test
18 [ T{ interval f { 1 f } { 2 f } } ] [ 1 2 (a,b) ] unit-test
20 [ T{ interval f { 1 f } { 2 t } } ] [ 1 2 (a,b] ] unit-test
22 [ T{ interval f { 1 t } { 1 t } } ] [ 1 [a,a] ] unit-test
24 [ t ] [ { 3 t } { 3 f } endpoint< ] unit-test
25 [ t ] [ { 2 f } { 3 f } endpoint< ] unit-test
26 [ f ] [ { 3 f } { 3 t } endpoint< ] unit-test
27 [ t ] [ { 4 f } { 3 t } endpoint> ] unit-test
28 [ f ] [ { 3 f } { 3 t } endpoint> ] unit-test
30 [ empty-interval ] [ 1 2 [a,b] empty-interval interval+ ] unit-test
32 [ empty-interval ] [ empty-interval 1 2 [a,b] interval+ ] unit-test
35 1 2 [a,b] -3 3 [a,b] interval+ -2 5 [a,b] =
39 1 2 [a,b] -3 3 (a,b) interval+ -2 5 (a,b) =
42 [ empty-interval ] [ 1 2 [a,b] empty-interval interval- ] unit-test
44 [ empty-interval ] [ empty-interval 1 2 [a,b] interval- ] unit-test
47 1 2 [a,b] 0 1 [a,b] interval- 0 2 [a,b] =
50 [ empty-interval ] [ 1 2 [a,b] empty-interval interval* ] unit-test
52 [ empty-interval ] [ empty-interval 1 2 [a,b] interval* ] unit-test
55 1 2 [a,b] 0 4 [a,b] interval* 0 8 [a,b] =
59 1 2 [a,b] -4 4 [a,b] interval* -8 8 [a,b] =
63 1 2 [a,b] -0.5 0.5 [a,b] interval* -1.0 1.0 [a,b] =
67 1 2 [a,b] -0.5 0.5 (a,b] interval* -1.0 1.0 (a,b] =
71 -1 1 [a,b] -1 1 (a,b] interval* -1 1 [a,b] =
74 [ t ] [ 1 2 [a,b] dup empty-interval interval-union = ] unit-test
76 [ t ] [ empty-interval 1 2 [a,b] tuck interval-union = ] unit-test
79 0 1 (a,b) 0 1 [a,b] interval-union 0 1 [a,b] =
83 0 1 (a,b) 1 2 [a,b] interval-union 0 2 (a,b] =
86 [ f ] [ 0 1 (a,b) f interval-union ] unit-test
89 0 1 (a,b) 0 1 [a,b] interval-intersect 0 1 (a,b) =
92 [ empty-interval ] [ 0 5 [a,b] -1 [a,a] interval-intersect ] unit-test
94 [ empty-interval ] [ 0 5 (a,b] 0 [a,a] interval-intersect ] unit-test
96 [ empty-interval ] [ empty-interval -1 [a,a] interval-intersect ] unit-test
98 [ empty-interval ] [ 0 5 (a,b] empty-interval interval-intersect ] unit-test
101 empty-interval empty-interval interval-subset?
105 empty-interval 0 1 [a,b] interval-subset?
109 0 1 (a,b) 0 1 [a,b] interval-subset?
113 0 0 1 (a,b) interval-contains?
117 0.5 0 1 (a,b) interval-contains?
121 1 0 1 (a,b) interval-contains?
124 [ empty-interval ] [ -1 1 (a,b) empty-interval interval/ ] unit-test
126 [ t ] [ 0 0 331 [a,b) -1775 -953 (a,b) interval/ interval-contains? ] unit-test
128 [ t ] [ -1 1 (a,b) -1 1 (a,b) interval/ [-inf,inf] = ] unit-test
130 [ t ] [ -1 1 (a,b) 0 1 (a,b) interval/ [-inf,inf] = ] unit-test
132 "math.ratios.private" vocab [
134 -1 1 (a,b) 0.5 1 (a,b) interval/ -2.0 2.0 (a,b) =
138 [ f ] [ empty-interval interval-singleton? ] unit-test
140 [ t ] [ 1 [a,a] interval-singleton? ] unit-test
142 [ f ] [ 1 1 [a,b) interval-singleton? ] unit-test
144 [ f ] [ 1 3 [a,b) interval-singleton? ] unit-test
146 [ f ] [ 1 1 (a,b) interval-singleton? ] unit-test
148 [ 2 ] [ 1 3 [a,b) interval-length ] unit-test
150 [ 0 ] [ empty-interval interval-length ] unit-test
152 [ t ] [ 0 5 [a,b] 5 [a,a] interval<= ] unit-test
154 [ incomparable ] [ empty-interval 5 [a,a] interval< ] unit-test
156 [ incomparable ] [ 5 [a,a] empty-interval interval< ] unit-test
158 [ incomparable ] [ 0 5 [a,b] 5 [a,a] interval< ] unit-test
160 [ t ] [ 0 5 [a,b) 5 [a,a] interval< ] unit-test
162 [ f ] [ 0 5 [a,b] -1 [a,a] interval< ] unit-test
164 [ incomparable ] [ 0 5 [a,b] 1 [a,a] interval< ] unit-test
166 [ t ] [ -1 1 (a,b) -1 [a,a] interval> ] unit-test
168 [ t ] [ -1 1 (a,b) -1 [a,a] interval>= ] unit-test
170 [ f ] [ -1 1 (a,b) -1 [a,a] interval< ] unit-test
172 [ f ] [ -1 1 (a,b) -1 [a,a] interval<= ] unit-test
174 [ t ] [ -1 1 (a,b] 1 [a,a] interval<= ] unit-test
176 [ t ] [ -1 1 (a,b] 1 2 [a,b] interval<= ] unit-test
178 [ incomparable ] [ -1 1 (a,b] empty-interval interval>= ] unit-test
180 [ incomparable ] [ empty-interval -1 1 (a,b] interval>= ] unit-test
182 [ incomparable ] [ -1 1 (a,b] 1 2 [a,b] interval>= ] unit-test
184 [ incomparable ] [ -1 1 (a,b] 1 2 [a,b] interval> ] unit-test
186 [ t ] [ -1 1 (a,b] 1 2 (a,b] interval<= ] unit-test
188 [ f ] [ 0 10 [a,b] 0 [a,a] interval< ] unit-test
190 [ f ] [ 0 10 [a,b] 10 [a,a] interval> ] unit-test
192 [ incomparable ] [ 0 [a,a] 0 10 [a,b] interval< ] unit-test
194 [ incomparable ] [ 10 [a,a] 0 10 [a,b] interval> ] unit-test
196 [ t ] [ 0 [a,a] 0 10 [a,b] interval<= ] unit-test
198 [ incomparable ] [ 0 [a,a] 0 10 [a,b] interval>= ] unit-test
200 [ t ] [ 0 10 [a,b] 0 [a,a] interval>= ] unit-test
210 [ t ] [ 1 100 [a,b] -1 1 [a,b] interval/i [-inf,inf] = ] unit-test
212 ! Interval random tester
213 : random-element ( interval -- n )
214 dup to>> first over from>> first tuck - random +
215 2dup swap interval-contains? [
221 : random-interval ( -- interval )
222 2000 random 1000 - dup 2 1000 random + +
223 1 random zero? [ [ neg ] bi@ swap ] when
231 : random-unary-op ( -- pair )
233 { bitnot interval-bitnot }
240 "math.ratios.private" vocab [
241 { recip interval-recip } suffix
245 : unary-test ( -- ? )
246 random-interval random-unary-op ! 2dup . .
247 0 pick interval-contains? over first \ recip eq? and [
250 [ >r random-element ! dup .
251 r> first execute ] 2keep
252 second execute interval-contains?
255 [ t ] [ 80000 [ drop unary-test ] all? ] unit-test
257 : random-binary-op ( -- pair )
265 { bitand interval-bitand }
266 { bitor interval-bitor }
267 { bitxor interval-bitxor }
268 { shift interval-shift }
272 "math.ratios.private" vocab [
273 { / interval/ } suffix
277 : binary-test ( -- ? )
278 random-interval random-interval random-binary-op ! 3dup . . .
279 0 pick interval-contains? over first { / /i mod rem } member? and [
282 [ >r [ random-element ] bi@ ! 2dup . .
283 r> first execute ] 3keep
284 second execute interval-contains?
287 [ t ] [ 80000 [ drop binary-test ] all? ] unit-test
289 : random-comparison ( -- pair )
297 : comparison-test ( -- ? )
298 random-interval random-interval random-comparison
299 [ >r [ random-element ] bi@ r> first execute ] 3keep
300 second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
302 [ t ] [ 40000 [ drop comparison-test ] all? ] unit-test
304 [ t ] [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
306 [ t ] [ -10 10 [a,b] 0 100 [a,b] assume>= 0 10 [a,b] = ] unit-test
308 [ t ] [ -10 10 [a,b] 0 100 [a,b] assume< -10 10 [a,b] = ] unit-test
310 [ t ] [ -10 10 [a,b] -100 0 [a,b] assume< -10 0 [a,b) = ] unit-test
312 [ t ] [ -10 10 [a,b] -100 0 [a,b] assume<= -10 0 [a,b] = ] unit-test
314 [ t ] [ -10 10 [a,b] 0 100 [a,b] assume<= -10 10 [a,b] = ] unit-test
316 [ t ] [ -10 10 [a,b] interval-abs 0 10 [a,b] = ] unit-test
318 ! Test that commutative interval ops really are
319 : random-interval-or-empty ( -- )
320 10 random 0 = [ empty-interval ] [ random-interval ] if ;
322 : random-commutative-op ( -- op )
325 interval-bitor interval-bitand interval-bitxor
326 interval-max interval-min
332 random-interval-or-empty random-interval-or-empty
333 random-commutative-op
334 [ execute ] [ swapd execute ] 3bi =