core/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 math ;
   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 boa ] if ; inline
  13
  14 : (scale) ( a b c d -- a*d b*c )
  15     [ * swap ] dip * swap ; inline
  16
  17 : scale ( a/b c/d -- a*d b*c )
  18     2>fraction (scale) ; inline
  19
  20 : scale+d ( a/b c/d -- a*d b*c b*d )
  21     2>fraction [ (scale) ] 2keep * ; inline
  22
  23 PRIVATE>
  24
  25 ERROR: division-by-zero x ;
  26
  27 M: integer /
  28     [
  29         division-by-zero
  30     ] [
  31         dup 0 < [ [ neg ] bi@ ] when
  32         2dup fast-gcd [ /i ] curry bi@ fraction>
  33     ] if-zero ;
  34
  35 M: integer recip
  36     1 swap [
  37         division-by-zero
  38     ] [
  39         dup 0 < [ [ neg ] bi@ ] when fraction>
  40     ] if-zero ;
  41
  42 M: ratio recip
  43     >fraction swap dup 0 < [ [ neg ] bi@ ] when fraction> ;
  44
  45 M: ratio hashcode*
  46     nip >fraction [ hashcode ] bi@ bitxor ;
  47
  48 M: ratio equal?
  49     over ratio? [
  50         2>fraction = [ = ] [ 2drop f ] if
  51     ] [ 2drop f ] if ;
  52
  53 M: ratio number=
  54     2>fraction number= [ number= ] [ 2drop f ] if ;
  55
  56 M: ratio >fixnum >fraction /i >fixnum ;
  57 M: ratio >bignum >fraction /i >bignum ;
  58 M: ratio >float >fraction /f ;
  59
  60 M: ratio numerator numerator>> ; inline
  61 M: ratio denominator denominator>> ; inline
  62 M: ratio >fraction [ numerator ] [ denominator ] bi ; inline
  63
  64 M: ratio < scale < ;
  65 M: ratio <= scale <= ;
  66 M: ratio > scale > ;
  67 M: ratio >= scale >= ;
  68
  69 M: ratio + scale+d [ + ] [ / ] bi* ;
  70 M: ratio - scale+d [ - ] [ / ] bi* ;
  71 M: ratio * 2>fraction [ * ] 2bi@ / ;
  72 M: ratio / scale / ;
  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