steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More accurate interval-mod and interval-rem

db4
Slava Pestov 2009-08-08 22:01:12 -05:00
parent 24a50c8006
commit 61ea749bb6
3 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -149,6 +149,12 @@ IN: compiler.tree.propagation.tests
] final-literals ] final-literals
] unit-test ] unit-test
[ V{ t } ] [ [ 40 mod 40 < ] final-literals ] unit-test
[ V{ f } ] [ [ 40 mod 0 >= ] final-literals ] unit-test
[ V{ t } ] [ [ 40 rem 0 >= ] final-literals ] unit-test
[ V{ string } ] [ [ V{ string } ] [
[ dup string? not [ "Oops" throw ] [ ] if ] final-classes [ dup string? not [ "Oops" throw ] [ ] if ] final-classes
] unit-test ] unit-test

4
basis/math/intervals/intervals-tests.factor
View File

@ -211,6 +211,10 @@ IN: math.intervals.tests
[ t ] [ 1 100 [a,b] -1 1 [a,b] interval/i [-inf,inf] = ] unit-test [ t ] [ 1 100 [a,b] -1 1 [a,b] interval/i [-inf,inf] = ] unit-test
! Accuracy of interval-mod
[ t ] [ full-interval 40 40 [a,b] interval-mod -40 40 (a,b) interval-subset?
] unit-test
! Interval random tester ! Interval random tester
: random-element ( interval -- n ) : random-element ( interval -- n )
dup full-interval eq? [ dup full-interval eq? [

24
basis/math/intervals/intervals.factor
View File

@ -270,20 +270,20 @@ TUPLE: interval { from read-only } { to read-only } ;
} cond ; } cond ;
: interval-mod ( i1 i2 -- i3 ) : interval-mod ( i1 i2 -- i3 )
#! Inaccurate. {
[ { [ over empty-interval eq? ] [ drop ] }
[ { [ dup empty-interval eq? ] [ nip ] }
nip interval-abs to>> first [ neg ] keep (a,b) { [ dup full-interval eq? ] [ nip ] }
] interval-division-op [ nip interval-abs to>> first [ neg ] keep (a,b) ]
] do-empty-interval ; } cond ;
: interval-rem ( i1 i2 -- i3 ) : interval-rem ( i1 i2 -- i3 )
#! Inaccurate. {
[ { [ over empty-interval eq? ] [ drop ] }
[ { [ dup empty-interval eq? ] [ nip ] }
nip interval-abs to>> first 0 swap [a,b) { [ dup full-interval eq? ] [ nip ] }
] interval-division-op [ nip interval-abs to>> first 0 swap [a,b) ]
] do-empty-interval ; } cond ;
: interval-recip ( i1 -- i2 ) 1 [a,a] swap interval/ ; : interval-recip ( i1 -- i2 ) 1 [a,a] swap interval/ ;