basis/math/ratios/ratios.factor

   1 ! Copyright (C) 2004, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel kernel.private math math.functions math.private ;
   4 IN: math.ratios
   5
   6 : 2>fraction ( a/b c/d -- a c b d )
   7     [ >fraction ] bi@ swapd ; inline
   8
   9 <PRIVATE
  10
  11 : fraction> ( a b -- a/b )
  12     dup 1 number= [ drop ] [ <ratio> ] if ; inline
  13
  14 : scale ( a/b c/d -- a*d b*c )
  15     2>fraction [ * swap ] dip * swap ; inline
  16
  17 : ratio+d ( a/b c/d -- b*d )
  18     [ denominator ] bi@ * ; inline
  19
  20 PRIVATE>
  21
  22 M: integer /
  23     dup zero? [
  24         "Division by zero" throw
  25     ] [
  26         dup 0 < [ [ neg ] bi@ ] when
  27         2dup gcd nip tuck [ /i ] 2bi@ fraction>
  28     ] if ;
  29
  30 M: ratio hashcode*
  31     nip >fraction [ hashcode ] bi@ bitxor ;
  32
  33 M: ratio equal?
  34     over ratio? [
  35         2>fraction = [ = ] [ 2drop f ] if
  36     ] [ 2drop f ] if ;
  37
  38 M: ratio number=
  39     2>fraction number= [ number= ] [ 2drop f ] if ;
  40
  41 M: ratio >fixnum >fraction /i >fixnum ;
  42 M: ratio >bignum >fraction /i >bignum ;
  43 M: ratio >float >fraction /f ;
  44
  45 M: ratio numerator numerator>> ;
  46 M: ratio denominator denominator>> ;
  47
  48 M: ratio < scale < ;
  49 M: ratio <= scale <= ;
  50 M: ratio > scale > ;
  51 M: ratio >= scale >= ;
  52
  53 M: ratio + [ scale + ] [ ratio+d ] 2bi / ;
  54 M: ratio - [ scale - ] [ ratio+d ] 2bi / ;
  55 M: ratio * 2>fraction [ * ] 2bi@ / ;
  56 M: ratio / scale / ;
  57 M: ratio /i scale /i ;
  58 M: ratio /f scale /f ;
  59 M: ratio mod 2dup /i * - ;
  60 M: ratio /mod [ /i ] 2keep mod ;