compiler.units continuations definitions destructors
effects.parser fry generic generic.math generic.parser
generic.single grouping io io.encodings io.styles kernel
-kernel.private lexer make math math.order math.parser namespaces
-parser prettyprint sequences sequences.private slots
-source-files.errors strings strings.parser summary system vocabs
-vocabs.loader vocabs.parser words ;
+kernel.private lexer make math math.order math.parser
+math.ratios namespaces parser prettyprint sequences
+sequences.private slots source-files.errors strings
+strings.parser summary system vocabs vocabs.loader vocabs.parser
+words ;
FROM: namespaces => change-global ;
IN: debugger
M: vm-error error-help vm-errors nth first ;
+M: division-by-zero summary
+ drop "Division by zero" ;
+
M: no-method summary
drop "No suitable method" ;
ABOUT: "math-functions"
-HELP: rect>
-{ $values { "x" real } { "y" real } { "z" number } }
-{ $description "Creates a complex number from real and imaginary components. If " { $snippet "z" } " is an integer zero, this will simply output " { $snippet "x" } "." } ;
-
-HELP: >rect
-{ $values { "z" number } { "x" real } { "y" real } }
-{ $description "Extracts the real and imaginary components of a complex number." } ;
-
HELP: align
{ $values { "m" integer } { "w" "a power of 2" } { "n" "an integer multiple of " { $snippet "w" } } }
{ $description "Outputs the least multiple of " { $snippet "w" } " greater than " { $snippet "m" } "." }
{ $values { "x" number } { "y" number } }
{ $description "Raises 10 to the power of " { $snippet "x" } ". If " { $snippet "x" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." } ;
-HELP: gcd
-{ $values { "x" integer } { "y" integer } { "a" integer } { "d" integer } }
-{ $description "Computes the positive greatest common divisor " { $snippet "d" } " of " { $snippet "x" } " and " { $snippet "y" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*y = d mod x" } }
-{ $notes "If " { $snippet "d" } " is 1, then " { $snippet "a" } " is the inverse of " { $snippet "y" } " modulo " { $snippet "x" } "." } ;
-
HELP: divisor?
{ $values { "m" integer } { "n" integer } { "?" boolean } }
{ $description "Tests if " { $snippet "n" } " is a divisor of " { $snippet "m" } ". This is the same thing as asking if " { $snippet "m" } " is divisible by " { $snippet "n" } "." }
{ t } [ 10 atanh tanh 10 1.e-10 ~ ] unit-test
{ t } [ 0.5 atanh tanh 0.5 1.e-10 ~ ] unit-test
-{ 100 } [ 100 100 gcd nip ] unit-test
-{ 100 } [ 1000 100 gcd nip ] unit-test
-{ 100 } [ 100 1000 gcd nip ] unit-test
-{ 4 } [ 132 64 gcd nip ] unit-test
-{ 4 } [ -132 64 gcd nip ] unit-test
-{ 4 } [ -132 -64 gcd nip ] unit-test
-{ 4 } [ 132 -64 gcd nip ] unit-test
-{ 4 } [ -132 -64 gcd nip ] unit-test
-
-{ 100 } [ 100 >bignum 100 >bignum gcd nip ] unit-test
-{ 100 } [ 1000 >bignum 100 >bignum gcd nip ] unit-test
-{ 100 } [ 100 >bignum 1000 >bignum gcd nip ] unit-test
-{ 4 } [ 132 >bignum 64 >bignum gcd nip ] unit-test
-{ 4 } [ -132 >bignum 64 >bignum gcd nip ] unit-test
-{ 4 } [ -132 >bignum -64 >bignum gcd nip ] unit-test
-{ 4 } [ 132 >bignum -64 >bignum gcd nip ] unit-test
-{ 4 } [ -132 >bignum -64 >bignum gcd nip ] unit-test
-
-{ 6 } [
- 1326264299060955293181542400000006
- 1591517158873146351817850880000000
- gcd nip
-] unit-test
-
-{ 11 } [
- 13262642990609552931815424
- 159151715887314635181785
- gcd nip
-] unit-test
-
-{ 3 } [
- 13262642990609552931
- 1591517158873146351
- gcd nip
-] unit-test
-
-{ 26525285981219 } [
- 132626429906095
- 159151715887314
- gcd nip
-] unit-test
-
-
-: verify-gcd ( a b -- ? )
- 2dup gcd
- [ rot * swap rem ] dip = ;
-
-{ t } [ 123 124 verify-gcd ] unit-test
-{ t } [ 50 120 verify-gcd ] unit-test
-
{ t } [ 0 42 divisor? ] unit-test
{ t } [ 42 7 divisor? ] unit-test
{ t } [ 42 -7 divisor? ] unit-test
math.libm combinators fry math.order sequences ;
IN: math.functions
-: rect> ( x y -- z )
- ! Note: an imaginary 0.0 should still create a complex
- dup 0 = [ drop ] [ complex boa ] if ; inline
-
GENERIC: sqrt ( x -- y ) foldable
M: real sqrt
PRIVATE>
-GENERIC: >rect ( z -- x y )
-
-M: real >rect 0 ; inline
-
-M: complex >rect [ real-part ] [ imaginary-part ] bi ; inline
-
: >float-rect ( z -- x y )
>rect [ >float ] bi@ ; inline
[ make-bits 1 ] dip dup
'[ [ over * _ mod ] when [ sq _ mod ] dip ] reduce nip ; inline
-: (gcd) ( b a x y -- a d )
- swap [
- nip
- ] [
- [ /mod [ over * swapd - ] dip ] keep (gcd)
- ] if-zero ; inline recursive
-
PRIVATE>
: ^ ( x y -- z )
: nth-root ( n x -- y ) swap recip ^ ; inline
-: gcd ( x y -- a d )
- [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; inline
-
-MATH: fast-gcd ( x y -- d ) foldable
-
-<PRIVATE
-
-: simple-gcd ( x y -- d ) gcd nip ; inline
-
-PRIVATE>
-
-M: real fast-gcd simple-gcd ; inline
-
-M: bignum fast-gcd bignum-gcd ; inline
-
: lcm ( a b -- c )
[ * ] 2keep fast-gcd /i ; foldable
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: help.markup help.syntax math math.private
-math.ratios.private math.functions ;
-IN: math.ratios
-
-ARTICLE: "rationals" "Rational numbers"
-{ $subsections ratio }
-"When we add, subtract or multiply any two integers, the result is always an integer. However, dividing a numerator by a denominator that is not an integral divisor of the denominator yields a ratio:"
-{ $example "1210 11 / ." "110" }
-{ $example "100 330 / ." "10/33" }
-{ $example "14 10 / ." "1+2/5" }
-"Ratios are printed and can be input literally in the form above. Ratios are always reduced to lowest terms by factoring out the greatest common divisor of the numerator and denominator. A ratio with a denominator of 1 becomes an integer. Division with a denominator of 0 throws an error."
-$nl
-"Ratios behave just like any other number -- all numerical operations work as you would expect."
-{ $example "1/2 1/3 + ." "5/6" }
-{ $example "100 6 / 3 * ." "50" }
-"Ratios can be taken apart:"
-{ $subsections
- numerator
- denominator
- >fraction
-}
-{ $see-also "syntax-ratios" } ;
-
-ABOUT: "rationals"
-
-HELP: ratio
-{ $class-description "The class of rational numbers with denominator not equal to 1." } ;
-
-HELP: rational
-{ $class-description "The class of rational numbers, a disjoint union of integers and ratios." } ;
-
-HELP: numerator
-{ $values { "a/b" rational } { "a" integer } }
-{ $description "Outputs the numerator of a rational number. Acts as the identity on integers." } ;
-
-HELP: denominator
-{ $values { "a/b" rational } { "b" "a positive integer" } }
-{ $description "Outputs the denominator of a rational number. Always outputs 1 with integers." } ;
-
-HELP: fraction>
-{ $values { "a" integer } { "b" "a positive integer" } { "a/b" rational } }
-{ $description "Creates a new ratio, or outputs the numerator if the denominator is 1. This word does not reduce the fraction to lowest terms, and should not be called directly; use " { $link / } " instead." } ;
-
-HELP: >fraction
-{ $values { "a/b" rational } { "a" integer } { "b" "a positive integer" } }
-{ $description "Extracts the numerator and denominator of a rational number." } ;
-
-HELP: 2>fraction
-{ $values { "a/b" rational } { "c/d" rational } { "a" integer } { "c" integer } { "b" "a positive integer" } { "d" "a positive integer" } }
-{ $description "Extracts the numerator and denominator of two rational numbers at once." } ;
+++ /dev/null
-USING: kernel math math.order math.parser math.ratios
-math.functions tools.test ;
-IN: math.ratios.tests
-
-{ 1 2 } [ 1/2 >fraction ] unit-test
-
-{ 1/2 } [ 1 >bignum 2 >bignum / ] unit-test
-{ t } [ 10 3 / ratio? ] unit-test
-{ f } [ 10 2 / ratio? ] unit-test
-{ 10 } [ 10 numerator ] unit-test
-{ 1 } [ 10 denominator ] unit-test
-{ 12 } [ -12 -13 / numerator ] unit-test
-{ 13 } [ -12 -13 / denominator ] unit-test
-{ 1 } [ -1 -1 / numerator ] unit-test
-{ 1 } [ -1 -1 / denominator ] unit-test
-
-{ -1 } [ 2 -2 / ] unit-test
-{ -1 } [ -2 2 / ] unit-test
-
-{ t } [ 1 3 / 1 3 / = ] unit-test
-
-{ -10 } [ -100 10 /i ] unit-test
-{ 10 } [ -100 -10 /i ] unit-test
-{ -10 } [ 100 -10 /i ] unit-test
-{ -10 } [ -100 >bignum 10 >bignum /i ] unit-test
-{ 10 } [ -100 >bignum -10 >bignum /i ] unit-test
-{ -10 } [ 100 >bignum -10 >bignum /i ] unit-test
-
-{ 3/2 } [ 1 1/2 + ] unit-test
-{ 3/2 } [ 1 >bignum 1/2 + ] unit-test
-{ -1/2 } [ 1/2 1 - ] unit-test
-{ -1/2 } [ 1/2 1 >bignum - ] unit-test
-{ 41/20 } [ 5/4 4/5 + ] unit-test
-
-{ 1 } [ 1/2 2 * ] unit-test
-{ 1/3 } [ 1/2 2/3 * ] unit-test
-
-{ 1 } [ 1/2 1/2 / ] unit-test
-{ 27/4 } [ 3/2 2/9 / ] unit-test
-
-{ t } [ 5768 476343 < ] unit-test
-{ t } [ 5768 476343 <= ] unit-test
-{ f } [ 5768 476343 > ] unit-test
-{ f } [ 5768 476343 >= ] unit-test
-{ t } [ 3434 >bignum 3434 >= ] unit-test
-{ t } [ 3434 3434 >bignum <= ] unit-test
-
-{ t } [ 1 1/3 > ] unit-test
-{ t } [ 2/3 3/4 <= ] unit-test
-{ f } [ -2/3 1/3 > ] unit-test
-
-{ t } [ 1000000000/999999 1000 > ] unit-test
-{ f } [ 100000 100000000000/999999 > ] unit-test
-{ t }
-[ 1000000000000/999999999999 1000000000001/999999999998 < ]
-unit-test
-
-{ -3 } [ -3 10 mod ] unit-test
-{ 7 } [ -3 10 rem ] unit-test
-{ 7 } [ -13 10 rem ] unit-test
-{ 0 } [ 37 37 rem ] unit-test
-
-{ -1 } [ -12.55 sgn ] unit-test
-{ 1 } [ 100000000000000000000000000000000 sgn ] unit-test
-{ 0 } [ 0.0 sgn ] unit-test
-
-{ 1/2 } [ 1/2 1 mod ] unit-test
-{ 1/3 } [ 10/3 3 mod ] unit-test
-{ -1/3 } [ -10/3 3 mod ] unit-test
-
-{ 4 1/2 } [ 3+1/2 3/4 /mod ] unit-test
-{ -4 -1/2 } [ -3-1/2 3/4 /mod ] unit-test
-{ 4 -1/2 } [ -3-1/2 -3/4 /mod ] unit-test
-{ -4 1/2 } [ 3+1/2 -3/4 /mod ] unit-test
-
-{ 5 } [ 5 floor ] unit-test
-{ -5 } [ -5 floor ] unit-test
-{ 6 } [ 6 truncate ] unit-test
-{ 3 } [ 10/3 floor ] unit-test
-{ -4 } [ -10/3 floor ] unit-test
-{ 4 } [ 10/3 ceiling ] unit-test
-{ -3 } [ -10/3 ceiling ] unit-test
-{ 3 } [ 10/3 truncate ] unit-test
-{ -3 } [ -10/3 truncate ] unit-test
-
-{ -1/2 } [ 1/2 1 - ] unit-test
-{ 3/2 } [ 1/2 1 + ] unit-test
-
-{ 1.0 } [ 0.5 1/2 + ] unit-test
-{ 1.0 } [ 1/2 0.5 + ] unit-test
-
-{ 1/134217728 } [ -1 -134217728 >fixnum / ] unit-test
-{ 134217728 } [ -134217728 >fixnum -1 / ] unit-test
-
-{ 5 }
-[ "10/2" string>number ]
-unit-test
-
-{ -5 }
-[ "-10/2" string>number ]
-unit-test
-
-{ f }
-[ "10/-2" string>number ]
-unit-test
-
-{ f }
-[ "-10/-2" string>number ]
-unit-test
-
-{ "33/100" }
-[ "66/200" string>number number>string ]
-unit-test
-
-{ 3 } [ "1+1/2" string>number 2 * ] unit-test
-{ -3 } [ "-1-1/2" string>number 2 * ] unit-test
-{ "2+1/7" } [ 1 7 / 2 + number>string ] unit-test
-{ "1/8" } [ 1 8 / number>string ] unit-test
-
-{ t } [ 2/3 dup number= ] unit-test
-{ t } [ 2/33333333333333333333333333333333 dup number= ] unit-test
-{ t } [ -2/3 dup number= ] unit-test
-{ t } [ -2/33333333333333333333333333333333 dup number= ] unit-test
+++ /dev/null
-! Copyright (C) 2004, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel kernel.private math math.functions
-math.private sequences summary ;
-IN: math.ratios
-
-: 2>fraction ( a/b c/d -- a c b d )
- [ >fraction ] bi@ swapd ; inline
-
-<PRIVATE
-
-: fraction> ( a b -- a/b )
- dup 1 number= [ drop ] [ ratio boa ] if ; inline
-
-: (scale) ( a b c d -- a*d b*c )
- [ * swap ] dip * swap ; inline
-
-: scale ( a/b c/d -- a*d b*c )
- 2>fraction (scale) ; inline
-
-: scale+d ( a/b c/d -- a*d b*c b*d )
- 2>fraction [ (scale) ] 2keep * ; inline
-
-PRIVATE>
-
-ERROR: division-by-zero x ;
-
-M: division-by-zero summary
- drop "Division by zero" ;
-
-M: integer /
- [
- division-by-zero
- ] [
- dup 0 < [ [ neg ] bi@ ] when
- 2dup fast-gcd [ /i ] curry bi@ fraction>
- ] if-zero ;
-
-M: integer recip
- 1 swap [
- division-by-zero
- ] [
- dup 0 < [ [ neg ] bi@ ] when fraction>
- ] if-zero ;
-
-M: ratio recip
- >fraction swap dup 0 < [ [ neg ] bi@ ] when fraction> ;
-
-M: ratio hashcode*
- nip >fraction [ hashcode ] bi@ bitxor ;
-
-M: ratio equal?
- over ratio? [
- 2>fraction = [ = ] [ 2drop f ] if
- ] [ 2drop f ] if ;
-
-M: ratio number=
- 2>fraction number= [ number= ] [ 2drop f ] if ;
-
-M: ratio >fixnum >fraction /i >fixnum ;
-M: ratio >bignum >fraction /i >bignum ;
-M: ratio >float >fraction /f ;
-
-M: ratio numerator numerator>> ; inline
-M: ratio denominator denominator>> ; inline
-M: ratio >fraction [ numerator ] [ denominator ] bi ; inline
-
-M: ratio < scale < ;
-M: ratio <= scale <= ;
-M: ratio > scale > ;
-M: ratio >= scale >= ;
-
-M: ratio + scale+d [ + ] [ / ] bi* ;
-M: ratio - scale+d [ - ] [ / ] bi* ;
-M: ratio * 2>fraction [ * ] 2bi@ / ;
-M: ratio / scale / ;
-M: ratio /i scale /i ;
-M: ratio /f scale /f ;
-M: ratio mod scale+d [ mod ] [ / ] bi* ;
-M: ratio /mod scale+d [ /mod ] [ / ] bi* ;
-M: ratio abs dup neg? [ >fraction [ neg ] dip fraction> ] when ;
-M: ratio neg? numerator neg? ; inline
+++ /dev/null
-Rational number implementation
] %
"math.integers" require
+ "math.ratios" require
"math.floats" require
"memory" require
}
} ;
+HELP: rect>
+{ $values { "x" real } { "y" real } { "z" number } }
+{ $description "Creates a complex number from real and imaginary components. If " { $snippet "z" } " is an integer zero, this will simply output " { $snippet "x" } "." } ;
+
+HELP: >rect
+{ $values { "z" number } { "x" real } { "y" real } }
+{ $description "Extracts the real and imaginary components of a complex number." } ;
+
+HELP: gcd
+{ $values { "x" integer } { "y" integer } { "a" integer } { "d" integer } }
+{ $description "Computes the positive greatest common divisor " { $snippet "d" } " of " { $snippet "x" } " and " { $snippet "y" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*y = d mod x" } }
+{ $notes "If " { $snippet "d" } " is 1, then " { $snippet "a" } " is the inverse of " { $snippet "y" } " modulo " { $snippet "x" } "." } ;
+
HELP: 2/
{ $values { "x" integer } { "y" integer } }
{ $description "Shifts " { $snippet "x" } " to the right by one bit." }
{ t } [ 128 2^ neg sq 256 2^ = ] unit-test
{ t } [ most-negative-fixnum dup >bignum bignum>fixnum-strict = ] unit-test
+
+{ 100 } [ 100 100 gcd nip ] unit-test
+{ 100 } [ 1000 100 gcd nip ] unit-test
+{ 100 } [ 100 1000 gcd nip ] unit-test
+{ 4 } [ 132 64 gcd nip ] unit-test
+{ 4 } [ -132 64 gcd nip ] unit-test
+{ 4 } [ -132 -64 gcd nip ] unit-test
+{ 4 } [ 132 -64 gcd nip ] unit-test
+{ 4 } [ -132 -64 gcd nip ] unit-test
+
+{ 100 } [ 100 >bignum 100 >bignum gcd nip ] unit-test
+{ 100 } [ 1000 >bignum 100 >bignum gcd nip ] unit-test
+{ 100 } [ 100 >bignum 1000 >bignum gcd nip ] unit-test
+{ 4 } [ 132 >bignum 64 >bignum gcd nip ] unit-test
+{ 4 } [ -132 >bignum 64 >bignum gcd nip ] unit-test
+{ 4 } [ -132 >bignum -64 >bignum gcd nip ] unit-test
+{ 4 } [ 132 >bignum -64 >bignum gcd nip ] unit-test
+{ 4 } [ -132 >bignum -64 >bignum gcd nip ] unit-test
+
+{ 6 } [
+ 1326264299060955293181542400000006
+ 1591517158873146351817850880000000
+ gcd nip
+] unit-test
+
+{ 11 } [
+ 13262642990609552931815424
+ 159151715887314635181785
+ gcd nip
+] unit-test
+
+{ 3 } [
+ 13262642990609552931
+ 1591517158873146351
+ gcd nip
+] unit-test
+
+{ 26525285981219 } [
+ 132626429906095
+ 159151715887314
+ gcd nip
+] unit-test
+
+
+: verify-gcd ( a b -- ? )
+ 2dup gcd
+ [ rot * swap rem ] dip = ;
+
+{ t } [ 123 124 verify-gcd ] unit-test
+{ t } [ 50 120 verify-gcd ] unit-test
UNION: integer fixnum bignum ;
-TUPLE: ratio { numerator integer read-only } { denominator integer read-only } ;
+TUPLE: ratio
+ { numerator integer read-only }
+ { denominator integer read-only } ;
UNION: rational integer ratio ;
UNION: real rational float ;
-TUPLE: complex { real real read-only } { imaginary real read-only } ;
+TUPLE: complex
+ { real real read-only }
+ { imaginary real read-only } ;
UNION: number real complex ;
M: number recip 1 swap / ; inline
+: rect> ( x y -- z )
+ ! Note: an imaginary 0.0 should still create a complex
+ dup 0 = [ drop ] [ complex boa ] if ; inline
+
+GENERIC: >rect ( z -- x y )
+
+M: real >rect 0 ; inline
+
+M: complex >rect [ real-part ] [ imaginary-part ] bi ; inline
+
+<PRIVATE
+
+: (gcd) ( b a x y -- a d )
+ swap [
+ nip
+ ] [
+ [ /mod [ over * swapd - ] dip ] keep (gcd)
+ ] if-zero ; inline recursive
+
+PRIVATE>
+
+: gcd ( x y -- a d )
+ [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; inline
+
+MATH: fast-gcd ( x y -- d ) foldable
+
+<PRIVATE
+
+: simple-gcd ( x y -- d ) gcd nip ; inline
+
+PRIVATE>
+
+M: real fast-gcd simple-gcd ; inline
+
+M: bignum fast-gcd bignum-gcd ; inline
+
: fp-bitwise= ( x y -- ? ) [ double>bits ] same? ; inline
GENERIC: fp-special? ( x -- ? )
--- /dev/null
+Slava Pestov
--- /dev/null
+USING: help.markup help.syntax math math.private
+math.ratios.private math.functions ;
+IN: math.ratios
+
+ARTICLE: "rationals" "Rational numbers"
+{ $subsections ratio }
+"When we add, subtract or multiply any two integers, the result is always an integer. However, dividing a numerator by a denominator that is not an integral divisor of the denominator yields a ratio:"
+{ $example "1210 11 / ." "110" }
+{ $example "100 330 / ." "10/33" }
+{ $example "14 10 / ." "1+2/5" }
+"Ratios are printed and can be input literally in the form above. Ratios are always reduced to lowest terms by factoring out the greatest common divisor of the numerator and denominator. A ratio with a denominator of 1 becomes an integer. Division with a denominator of 0 throws an error."
+$nl
+"Ratios behave just like any other number -- all numerical operations work as you would expect."
+{ $example "1/2 1/3 + ." "5/6" }
+{ $example "100 6 / 3 * ." "50" }
+"Ratios can be taken apart:"
+{ $subsections
+ numerator
+ denominator
+ >fraction
+}
+{ $see-also "syntax-ratios" } ;
+
+ABOUT: "rationals"
+
+HELP: ratio
+{ $class-description "The class of rational numbers with denominator not equal to 1." } ;
+
+HELP: rational
+{ $class-description "The class of rational numbers, a disjoint union of integers and ratios." } ;
+
+HELP: numerator
+{ $values { "a/b" rational } { "a" integer } }
+{ $description "Outputs the numerator of a rational number. Acts as the identity on integers." } ;
+
+HELP: denominator
+{ $values { "a/b" rational } { "b" "a positive integer" } }
+{ $description "Outputs the denominator of a rational number. Always outputs 1 with integers." } ;
+
+HELP: fraction>
+{ $values { "a" integer } { "b" "a positive integer" } { "a/b" rational } }
+{ $description "Creates a new ratio, or outputs the numerator if the denominator is 1. This word does not reduce the fraction to lowest terms, and should not be called directly; use " { $link / } " instead." } ;
+
+HELP: >fraction
+{ $values { "a/b" rational } { "a" integer } { "b" "a positive integer" } }
+{ $description "Extracts the numerator and denominator of a rational number." } ;
+
+HELP: 2>fraction
+{ $values { "a/b" rational } { "c/d" rational } { "a" integer } { "c" integer } { "b" "a positive integer" } { "d" "a positive integer" } }
+{ $description "Extracts the numerator and denominator of two rational numbers at once." } ;
--- /dev/null
+USING: kernel math math.order math.parser math.ratios
+math.functions tools.test ;
+IN: math.ratios.tests
+
+{ 1 2 } [ 1/2 >fraction ] unit-test
+
+{ 1/2 } [ 1 >bignum 2 >bignum / ] unit-test
+{ t } [ 10 3 / ratio? ] unit-test
+{ f } [ 10 2 / ratio? ] unit-test
+{ 10 } [ 10 numerator ] unit-test
+{ 1 } [ 10 denominator ] unit-test
+{ 12 } [ -12 -13 / numerator ] unit-test
+{ 13 } [ -12 -13 / denominator ] unit-test
+{ 1 } [ -1 -1 / numerator ] unit-test
+{ 1 } [ -1 -1 / denominator ] unit-test
+
+{ -1 } [ 2 -2 / ] unit-test
+{ -1 } [ -2 2 / ] unit-test
+
+{ t } [ 1 3 / 1 3 / = ] unit-test
+
+{ -10 } [ -100 10 /i ] unit-test
+{ 10 } [ -100 -10 /i ] unit-test
+{ -10 } [ 100 -10 /i ] unit-test
+{ -10 } [ -100 >bignum 10 >bignum /i ] unit-test
+{ 10 } [ -100 >bignum -10 >bignum /i ] unit-test
+{ -10 } [ 100 >bignum -10 >bignum /i ] unit-test
+
+{ 3/2 } [ 1 1/2 + ] unit-test
+{ 3/2 } [ 1 >bignum 1/2 + ] unit-test
+{ -1/2 } [ 1/2 1 - ] unit-test
+{ -1/2 } [ 1/2 1 >bignum - ] unit-test
+{ 41/20 } [ 5/4 4/5 + ] unit-test
+
+{ 1 } [ 1/2 2 * ] unit-test
+{ 1/3 } [ 1/2 2/3 * ] unit-test
+
+{ 1 } [ 1/2 1/2 / ] unit-test
+{ 27/4 } [ 3/2 2/9 / ] unit-test
+
+{ t } [ 5768 476343 < ] unit-test
+{ t } [ 5768 476343 <= ] unit-test
+{ f } [ 5768 476343 > ] unit-test
+{ f } [ 5768 476343 >= ] unit-test
+{ t } [ 3434 >bignum 3434 >= ] unit-test
+{ t } [ 3434 3434 >bignum <= ] unit-test
+
+{ t } [ 1 1/3 > ] unit-test
+{ t } [ 2/3 3/4 <= ] unit-test
+{ f } [ -2/3 1/3 > ] unit-test
+
+{ t } [ 1000000000/999999 1000 > ] unit-test
+{ f } [ 100000 100000000000/999999 > ] unit-test
+{ t }
+[ 1000000000000/999999999999 1000000000001/999999999998 < ]
+unit-test
+
+{ -3 } [ -3 10 mod ] unit-test
+{ 7 } [ -3 10 rem ] unit-test
+{ 7 } [ -13 10 rem ] unit-test
+{ 0 } [ 37 37 rem ] unit-test
+
+{ -1 } [ -12.55 sgn ] unit-test
+{ 1 } [ 100000000000000000000000000000000 sgn ] unit-test
+{ 0 } [ 0.0 sgn ] unit-test
+
+{ 1/2 } [ 1/2 1 mod ] unit-test
+{ 1/3 } [ 10/3 3 mod ] unit-test
+{ -1/3 } [ -10/3 3 mod ] unit-test
+
+{ 4 1/2 } [ 3+1/2 3/4 /mod ] unit-test
+{ -4 -1/2 } [ -3-1/2 3/4 /mod ] unit-test
+{ 4 -1/2 } [ -3-1/2 -3/4 /mod ] unit-test
+{ -4 1/2 } [ 3+1/2 -3/4 /mod ] unit-test
+
+{ 5 } [ 5 floor ] unit-test
+{ -5 } [ -5 floor ] unit-test
+{ 6 } [ 6 truncate ] unit-test
+{ 3 } [ 10/3 floor ] unit-test
+{ -4 } [ -10/3 floor ] unit-test
+{ 4 } [ 10/3 ceiling ] unit-test
+{ -3 } [ -10/3 ceiling ] unit-test
+{ 3 } [ 10/3 truncate ] unit-test
+{ -3 } [ -10/3 truncate ] unit-test
+
+{ -1/2 } [ 1/2 1 - ] unit-test
+{ 3/2 } [ 1/2 1 + ] unit-test
+
+{ 1.0 } [ 0.5 1/2 + ] unit-test
+{ 1.0 } [ 1/2 0.5 + ] unit-test
+
+{ 1/134217728 } [ -1 -134217728 >fixnum / ] unit-test
+{ 134217728 } [ -134217728 >fixnum -1 / ] unit-test
+
+{ 5 }
+[ "10/2" string>number ]
+unit-test
+
+{ -5 }
+[ "-10/2" string>number ]
+unit-test
+
+{ f }
+[ "10/-2" string>number ]
+unit-test
+
+{ f }
+[ "-10/-2" string>number ]
+unit-test
+
+{ "33/100" }
+[ "66/200" string>number number>string ]
+unit-test
+
+{ 3 } [ "1+1/2" string>number 2 * ] unit-test
+{ -3 } [ "-1-1/2" string>number 2 * ] unit-test
+{ "2+1/7" } [ 1 7 / 2 + number>string ] unit-test
+{ "1/8" } [ 1 8 / number>string ] unit-test
+
+{ t } [ 2/3 dup number= ] unit-test
+{ t } [ 2/33333333333333333333333333333333 dup number= ] unit-test
+{ t } [ -2/3 dup number= ] unit-test
+{ t } [ -2/33333333333333333333333333333333 dup number= ] unit-test
--- /dev/null
+! Copyright (C) 2004, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel math ;
+IN: math.ratios
+
+: 2>fraction ( a/b c/d -- a c b d )
+ [ >fraction ] bi@ swapd ; inline
+
+<PRIVATE
+
+: fraction> ( a b -- a/b )
+ dup 1 number= [ drop ] [ ratio boa ] if ; inline
+
+: (scale) ( a b c d -- a*d b*c )
+ [ * swap ] dip * swap ; inline
+
+: scale ( a/b c/d -- a*d b*c )
+ 2>fraction (scale) ; inline
+
+: scale+d ( a/b c/d -- a*d b*c b*d )
+ 2>fraction [ (scale) ] 2keep * ; inline
+
+PRIVATE>
+
+ERROR: division-by-zero x ;
+
+M: integer /
+ [
+ division-by-zero
+ ] [
+ dup 0 < [ [ neg ] bi@ ] when
+ 2dup fast-gcd [ /i ] curry bi@ fraction>
+ ] if-zero ;
+
+M: integer recip
+ 1 swap [
+ division-by-zero
+ ] [
+ dup 0 < [ [ neg ] bi@ ] when fraction>
+ ] if-zero ;
+
+M: ratio recip
+ >fraction swap dup 0 < [ [ neg ] bi@ ] when fraction> ;
+
+M: ratio hashcode*
+ nip >fraction [ hashcode ] bi@ bitxor ;
+
+M: ratio equal?
+ over ratio? [
+ 2>fraction = [ = ] [ 2drop f ] if
+ ] [ 2drop f ] if ;
+
+M: ratio number=
+ 2>fraction number= [ number= ] [ 2drop f ] if ;
+
+M: ratio >fixnum >fraction /i >fixnum ;
+M: ratio >bignum >fraction /i >bignum ;
+M: ratio >float >fraction /f ;
+
+M: ratio numerator numerator>> ; inline
+M: ratio denominator denominator>> ; inline
+M: ratio >fraction [ numerator ] [ denominator ] bi ; inline
+
+M: ratio < scale < ;
+M: ratio <= scale <= ;
+M: ratio > scale > ;
+M: ratio >= scale >= ;
+
+M: ratio + scale+d [ + ] [ / ] bi* ;
+M: ratio - scale+d [ - ] [ / ] bi* ;
+M: ratio * 2>fraction [ * ] 2bi@ / ;
+M: ratio / scale / ;
+M: ratio /i scale /i ;
+M: ratio /f scale /f ;
+M: ratio mod scale+d [ mod ] [ / ] bi* ;
+M: ratio /mod scale+d [ /mod ] [ / ] bi* ;
+M: ratio abs dup neg? [ >fraction [ neg ] dip fraction> ] when ;
+M: ratio neg? numerator neg? ; inline
--- /dev/null
+Rational number implementation
projects / factor.git / commitdiff