core/math/ratios/ratios.factor

   1 ! Copyright (C) 2004, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: math.ratios.private
   4 USING: kernel kernel.private math math.functions
   5 math.private ;
   6
   7 : fraction> ( a b -- a/b )
   8     dup 1 number= [ drop ] [ <ratio> ] if ; inline
   9
  10 M: integer /
  11     dup zero? [
  12         /i
  13     ] [
  14         dup 0 < [ [ neg ] 2apply ] when
  15         2dup gcd nip tuck /i >r /i r> fraction>
  16     ] if ;
  17
  18 : 2>fraction ( a/b c/d -- a c b d )
  19     [ >fraction ] 2apply swapd ; inline
  20
  21 : scale ( a/b c/d -- a*d b*c )
  22     2>fraction >r * swap r> * swap ; inline
  23
  24 : ratio+d ( a/b c/d -- b*d )
  25     denominator swap denominator * ; inline
  26
  27 M: ratio number=
  28     2>fraction number= [ number= ] [ 2drop f ] if ;
  29
  30 M: ratio >fixnum >fraction /i >fixnum ;
  31 M: ratio >bignum >fraction /i >bignum ;
  32 M: ratio >float >fraction /f ;
  33
  34 M: ratio < scale < ;
  35 M: ratio <= scale <= ;
  36 M: ratio > scale > ;
  37 M: ratio >= scale >= ;
  38
  39 M: ratio + 2dup scale + -rot ratio+d / ;
  40 M: ratio - 2dup scale - -rot ratio+d / ;
  41 M: ratio * 2>fraction * >r * r> / ;
  42 M: ratio / scale / ;
  43 M: ratio /i scale /i ;
  44 M: ratio mod 2dup >r >r /i r> r> rot * - ;