1 USING: math.intervals kernel sequences words math math.order
2 arrays prettyprint tools.test random vocabs combinators
3 accessors math.constants fry ;
4 IN: math.intervals.tests
6 { empty-interval } [ 2 2 (a,b) ] unit-test
8 { empty-interval } [ 2 2.0 (a,b) ] unit-test
10 { empty-interval } [ 2 2 [a,b) ] unit-test
12 { empty-interval } [ 2 2 (a,b] ] unit-test
14 { empty-interval } [ 3 2 [a,b] ] unit-test
16 { T{ interval f { 1 t } { 2 t } } } [ 1 2 [a,b] ] unit-test
18 { T{ interval f { 1 t } { 2 f } } } [ 1 2 [a,b) ] unit-test
20 { T{ interval f { 1 f } { 2 f } } } [ 1 2 (a,b) ] unit-test
22 { T{ interval f { 1 f } { 2 t } } } [ 1 2 (a,b] ] unit-test
24 { T{ interval f { 1 t } { 1 t } } } [ 1 [a,a] ] unit-test
26 ! Not sure how to handle NaNs yet...
27 ! [ 1 0/0. [a,b] ] must-fail
28 ! [ 0/0. 1 [a,b] ] must-fail
30 { t } [ { 3 t } { 3 f } endpoint< ] unit-test
31 { t } [ { 2 f } { 3 f } endpoint< ] unit-test
32 { f } [ { 3 f } { 3 t } endpoint< ] unit-test
33 { t } [ { 4 f } { 3 t } endpoint> ] unit-test
34 { f } [ { 3 f } { 3 t } endpoint> ] unit-test
36 { empty-interval } [ 1 2 [a,b] empty-interval interval+ ] unit-test
38 { empty-interval } [ empty-interval 1 2 [a,b] interval+ ] unit-test
41 1 2 [a,b] -3 3 [a,b] interval+ -2 5 [a,b] =
45 1 2 [a,b] -3 3 (a,b) interval+ -2 5 (a,b) =
48 { empty-interval } [ 1 2 [a,b] empty-interval interval- ] unit-test
50 { empty-interval } [ empty-interval 1 2 [a,b] interval- ] unit-test
53 1 2 [a,b] 0 1 [a,b] interval- 0 2 [a,b] =
56 { empty-interval } [ 1 2 [a,b] empty-interval interval* ] unit-test
58 { empty-interval } [ empty-interval 1 2 [a,b] interval* ] unit-test
61 1 2 [a,b] 0 4 [a,b] interval* 0 8 [a,b] =
65 1 2 [a,b] -4 4 [a,b] interval* -8 8 [a,b] =
69 1 2 [a,b] -0.5 0.5 [a,b] interval* -1.0 1.0 [a,b] =
73 1 2 [a,b] -0.5 0.5 (a,b] interval* -1.0 1.0 (a,b] =
77 -1 1 [a,b] -1 1 (a,b] interval* -1 1 [a,b] =
80 { t } [ 1 2 [a,b] dup empty-interval interval-union = ] unit-test
82 { t } [ 1 2 [a,b] empty-interval over interval-union = ] unit-test
85 0 1 (a,b) 0 1 [a,b] interval-union 0 1 [a,b] =
89 0 1 (a,b) 1 2 [a,b] interval-union 0 2 (a,b] =
93 0 1 (a,b) 0 1 [a,b] interval-intersect 0 1 (a,b) =
96 { empty-interval } [ 0 5 [a,b] -1 [a,a] interval-intersect ] unit-test
98 { empty-interval } [ 0 5 (a,b] 0 [a,a] interval-intersect ] unit-test
100 { empty-interval } [ empty-interval -1 [a,a] interval-intersect ] unit-test
102 { empty-interval } [ 0 5 (a,b] empty-interval interval-intersect ] unit-test
105 0 1 (a,b) full-interval interval-intersect 0 1 (a,b) =
109 empty-interval empty-interval interval-subset?
113 empty-interval 0 1 [a,b] interval-subset?
117 0 1 (a,b) 0 1 [a,b] interval-subset?
121 full-interval -1/0. 1/0. [a,b] interval-subset?
125 -1/0. 1/0. [a,b] full-interval interval-subset?
129 full-interval 0 1/0. [a,b] interval-subset?
133 0 1/0. [a,b] full-interval interval-subset?
137 0 0 1 (a,b) interval-contains?
141 0.5 0 1 (a,b) interval-contains?
145 1 0 1 (a,b) interval-contains?
148 { empty-interval } [ -1 1 (a,b) empty-interval interval/ ] unit-test
150 { t } [ 0 0 331 [a,b) -1775 -953 (a,b) interval/ interval-contains? ] unit-test
152 { t } [ -1 1 (a,b) -1 1 (a,b) interval/ [-inf,inf] = ] unit-test
154 { t } [ -1 1 (a,b) 0 1 (a,b) interval/ [-inf,inf] = ] unit-test
156 "math.ratios.private" lookup-vocab [
158 -1 1 (a,b) 0.5 1 (a,b) interval/ -2.0 2.0 (a,b) =
162 { f } [ empty-interval interval-singleton? ] unit-test
164 { t } [ 1 [a,a] interval-singleton? ] unit-test
166 { f } [ 1 1 [a,b) interval-singleton? ] unit-test
168 { f } [ 1 3 [a,b) interval-singleton? ] unit-test
170 { f } [ 1 1 (a,b) interval-singleton? ] unit-test
172 { 2 } [ 1 3 [a,b) interval-length ] unit-test
174 { 0 } [ empty-interval interval-length ] unit-test
176 { t } [ 0 5 [a,b] 5 [a,a] interval<= ] unit-test
178 { incomparable } [ empty-interval 5 [a,a] interval< ] unit-test
180 { incomparable } [ 5 [a,a] empty-interval interval< ] unit-test
182 { incomparable } [ 0 5 [a,b] 5 [a,a] interval< ] unit-test
184 { t } [ 0 5 [a,b) 5 [a,a] interval< ] unit-test
186 { f } [ 0 5 [a,b] -1 [a,a] interval< ] unit-test
188 { incomparable } [ 0 5 [a,b] 1 [a,a] interval< ] unit-test
190 { t } [ -1 1 (a,b) -1 [a,a] interval> ] unit-test
192 { t } [ -1 1 (a,b) -1 [a,a] interval>= ] unit-test
194 { f } [ -1 1 (a,b) -1 [a,a] interval< ] unit-test
196 { f } [ -1 1 (a,b) -1 [a,a] interval<= ] unit-test
198 { t } [ -1 1 (a,b] 1 [a,a] interval<= ] unit-test
200 { t } [ -1 1 (a,b] 1 2 [a,b] interval<= ] unit-test
202 { incomparable } [ -1 1 (a,b] empty-interval interval>= ] unit-test
204 { incomparable } [ empty-interval -1 1 (a,b] interval>= ] unit-test
206 { incomparable } [ -1 1 (a,b] 1 2 [a,b] interval>= ] unit-test
208 { incomparable } [ -1 1 (a,b] 1 2 [a,b] interval> ] unit-test
210 { t } [ -1 1 (a,b] 1 2 (a,b] interval<= ] unit-test
212 { f } [ 0 10 [a,b] 0 [a,a] interval< ] unit-test
214 { f } [ 0 10 [a,b] 0.0 [a,a] interval< ] unit-test
216 { f } [ 0.0 10 [a,b] 0 [a,a] interval< ] unit-test
218 { f } [ 0 10 [a,b] 10 [a,a] interval> ] unit-test
220 { incomparable } [ 0 [a,a] 0 10 [a,b] interval< ] unit-test
222 { incomparable } [ 10 [a,a] 0 10 [a,b] interval> ] unit-test
224 { t } [ 0 [a,a] 0 10 [a,b] interval<= ] unit-test
226 { incomparable } [ 0 [a,a] 0 10 [a,b] interval>= ] unit-test
228 { t } [ 0 10 [a,b] 0 [a,a] interval>= ] unit-test
238 { t } [ full-interval 10 10 [a,b] interval-max 10 1/0. [a,b] = ] unit-test
240 { t } [ full-interval 10 10 [a,b] interval-min -1/0. 10 [a,b] = ] unit-test
242 { t } [ 1 100 [a,b] -1 1 [a,b] interval/i [-inf,inf] = ] unit-test
244 ! Accuracy of interval-mod
245 { t } [ full-interval 40 40 [a,b] interval-mod -40 40 (a,b) interval-subset?
248 ! Interval random tester
249 : random-element ( interval -- n )
250 dup full-interval eq? [
251 drop 32 random-bits 31 2^ -
253 [ ] [ from>> first ] [ to>> first ] tri over - random +
254 2dup swap interval-contains? [
261 : random-interval ( -- interval )
262 10 random 0 = [ full-interval ] [
263 2000 random 1000 - dup 2 1000 random + +
264 1 random zero? [ [ neg ] bi@ swap ] when
273 : unary-ops ( -- alist )
275 { bitnot interval-bitnot }
280 "math.ratios.private" lookup-vocab [
281 { recip interval-recip } suffix
284 : unary-test ( op -- ? )
285 [ random-interval ] dip
286 0 pick interval-contains? over first \ recip eq? and [
289 [ [ random-element ] dip first execute( a -- b ) ] 2keep
290 second execute( a -- b ) interval-contains?
294 [ [ t ] ] dip '[ 8000 [ drop _ unary-test ] all-integers? ] unit-test
297 : binary-ops ( -- alist )
305 { bitand interval-bitand }
306 { bitor interval-bitor }
307 { bitxor interval-bitxor }
311 "math.ratios.private" lookup-vocab [
312 { / interval/ } suffix
315 : binary-test ( op -- ? )
316 [ random-interval random-interval ] dip
317 0 pick interval-contains? over first { / /i mod rem } member? and [
320 [ [ [ random-element ] bi@ ] dip first execute( a b -- c ) ] 3keep
321 second execute( a b -- c ) interval-contains?
325 [ [ t ] ] dip '[ 8000 iota [ drop _ binary-test ] all? ] unit-test
328 : comparison-ops ( -- alist )
336 : comparison-test ( op -- ? )
337 [ random-interval random-interval ] dip
338 [ [ [ random-element ] bi@ ] dip first execute( a b -- ? ) ] 3keep
339 second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
342 [ [ t ] ] dip '[ 8000 iota [ drop _ comparison-test ] all? ] unit-test
345 { t } [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
347 { t } [ -10 10 [a,b] 0 100 [a,b] assume>= 0 10 [a,b] = ] unit-test
349 { t } [ -10 10 [a,b] 0 100 [a,b] assume< -10 10 [a,b] = ] unit-test
351 { t } [ -10 10 [a,b] -100 0 [a,b] assume< -10 0 [a,b) = ] unit-test
353 { t } [ -10 10 [a,b] -100 0 [a,b] assume<= -10 0 [a,b] = ] unit-test
355 { t } [ -10 10 [a,b] 0 100 [a,b] assume<= -10 10 [a,b] = ] unit-test
357 { t } [ -10 10 [a,b] interval-abs 0 10 [a,b] = ] unit-test
359 { t } [ full-interval interval-abs [0,inf] = ] unit-test
361 { t } [ [0,inf] interval-abs [0,inf] = ] unit-test
363 { t } [ empty-interval interval-abs empty-interval = ] unit-test
365 { t } [ [0,inf] interval-sq [0,inf] = ] unit-test
367 ! Test that commutative interval ops really are
368 : random-interval-or-empty ( -- obj )
369 10 random 0 = [ empty-interval ] [ random-interval ] if ;
371 : commutative-ops ( -- seq )
374 interval-bitor interval-bitand interval-bitxor
375 interval-max interval-min
382 random-interval-or-empty random-interval-or-empty _
383 [ execute ] [ swapd execute ] 3bi =