1 ! Copyright (C) 2004, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel math ;
6 : 2>fraction ( a/b c/d -- a c b d )
7 [ >fraction ] bi@ swapd ; inline
11 : fraction> ( a b -- a/b )
12 dup 1 number= [ drop ] [ ratio boa ] if ; inline
14 : (scale) ( a b c d -- a*d b*c )
15 [ * swap ] dip * swap ; inline
17 : scale ( a/b c/d -- a*d b*c )
18 2>fraction (scale) ; inline
20 : scale+d ( a/b c/d -- a*d b*c b*d )
21 2>fraction [ (scale) ] 2keep * ; inline
25 ERROR: division-by-zero x ;
29 throw-division-by-zero
31 dup 0 < [ [ neg ] bi@ ] when
32 2dup fast-gcd [ /i ] curry bi@ fraction>
37 throw-division-by-zero
39 dup 0 < [ [ neg ] bi@ ] when fraction>
43 >fraction swap dup 0 < [ [ neg ] bi@ ] when fraction> ;
46 nip >fraction [ hashcode ] bi@ bitxor ;
50 2>fraction = [ = ] [ 2drop f ] if
54 2>fraction number= [ number= ] [ 2drop f ] if ;
56 M: ratio >fixnum >fraction /i >fixnum ;
57 M: ratio >bignum >fraction /i >bignum ;
58 M: ratio >float >fraction /f ;
60 M: ratio numerator numerator>> ; inline
61 M: ratio denominator denominator>> ; inline
62 M: ratio >fraction [ numerator ] [ denominator ] bi ; inline
65 M: ratio <= scale <= ;
67 M: ratio >= scale >= ;
69 M: ratio + scale+d [ + ] [ / ] bi* ;
70 M: ratio - scale+d [ - ] [ / ] bi* ;
71 M: ratio * 2>fraction [ * ] 2bi@ / ;
73 M: ratio /i scale /i ;
74 M: ratio /f scale /f ;
75 M: ratio mod scale+d [ mod ] [ / ] bi* ;
76 M: ratio /mod scale+d [ /mod ] [ / ] bi* ;
77 M: ratio abs dup neg? [ >fraction [ neg ] dip fraction> ] when ;
78 M: ratio neg? numerator neg? ; inline