math.ratios: moving to core.
parent
465dc8d231
commit
c6fad4aa61
|
@ -6,10 +6,11 @@ combinators combinators.short-circuit compiler.errors
|
||||||
compiler.units continuations definitions destructors
|
compiler.units continuations definitions destructors
|
||||||
effects.parser fry generic generic.math generic.parser
|
effects.parser fry generic generic.math generic.parser
|
||||||
generic.single grouping io io.encodings io.styles kernel
|
generic.single grouping io io.encodings io.styles kernel
|
||||||
kernel.private lexer make math math.order math.parser namespaces
|
kernel.private lexer make math math.order math.parser
|
||||||
parser prettyprint sequences sequences.private slots
|
math.ratios namespaces parser prettyprint sequences
|
||||||
source-files.errors strings strings.parser summary system vocabs
|
sequences.private slots source-files.errors strings
|
||||||
vocabs.loader vocabs.parser words ;
|
strings.parser summary system vocabs vocabs.loader vocabs.parser
|
||||||
|
words ;
|
||||||
FROM: namespaces => change-global ;
|
FROM: namespaces => change-global ;
|
||||||
IN: debugger
|
IN: debugger
|
||||||
|
|
||||||
|
@ -190,6 +191,9 @@ M: vm-error error. dup vm-errors dispatch ;
|
||||||
|
|
||||||
M: vm-error error-help vm-errors nth first ;
|
M: vm-error error-help vm-errors nth first ;
|
||||||
|
|
||||||
|
M: division-by-zero summary
|
||||||
|
drop "Division by zero" ;
|
||||||
|
|
||||||
M: no-method summary
|
M: no-method summary
|
||||||
drop "No suitable method" ;
|
drop "No suitable method" ;
|
||||||
|
|
||||||
|
|
|
@ -95,14 +95,6 @@ ARTICLE: "math-functions" "Mathematical functions"
|
||||||
|
|
||||||
ABOUT: "math-functions"
|
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
|
HELP: align
|
||||||
{ $values { "m" integer } { "w" "a power of 2" } { "n" "an integer multiple of " { $snippet "w" } } }
|
{ $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" } "." }
|
{ $description "Outputs the least multiple of " { $snippet "w" } " greater than " { $snippet "m" } "." }
|
||||||
|
@ -280,11 +272,6 @@ HELP: 10^
|
||||||
{ $values { "x" number } { "y" number } }
|
{ $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." } ;
|
{ $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?
|
HELP: divisor?
|
||||||
{ $values { "m" integer } { "n" integer } { "?" boolean } }
|
{ $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" } "." }
|
{ $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" } "." }
|
||||||
|
|
|
@ -127,56 +127,6 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
|
||||||
{ t } [ 10 atanh tanh 10 1.e-10 ~ ] unit-test
|
{ t } [ 10 atanh tanh 10 1.e-10 ~ ] unit-test
|
||||||
{ t } [ 0.5 atanh tanh 0.5 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 } [ 0 42 divisor? ] unit-test
|
||||||
{ t } [ 42 7 divisor? ] unit-test
|
{ t } [ 42 7 divisor? ] unit-test
|
||||||
{ t } [ 42 -7 divisor? ] unit-test
|
{ t } [ 42 -7 divisor? ] unit-test
|
||||||
|
|
|
@ -4,10 +4,6 @@ USING: math kernel math.constants math.private math.bits
|
||||||
math.libm combinators fry math.order sequences ;
|
math.libm combinators fry math.order sequences ;
|
||||||
IN: math.functions
|
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
|
GENERIC: sqrt ( x -- y ) foldable
|
||||||
|
|
||||||
M: real sqrt
|
M: real sqrt
|
||||||
|
@ -55,12 +51,6 @@ M: complex ^n (^n) ;
|
||||||
|
|
||||||
PRIVATE>
|
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 )
|
: >float-rect ( z -- x y )
|
||||||
>rect [ >float ] bi@ ; inline
|
>rect [ >float ] bi@ ; inline
|
||||||
|
|
||||||
|
@ -103,13 +93,6 @@ M: complex e^ >rect [ e^ ] dip polar> ; inline
|
||||||
[ make-bits 1 ] dip dup
|
[ make-bits 1 ] dip dup
|
||||||
'[ [ over * _ mod ] when [ sq _ mod ] dip ] reduce nip ; inline
|
'[ [ 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>
|
PRIVATE>
|
||||||
|
|
||||||
: ^ ( x y -- z )
|
: ^ ( x y -- z )
|
||||||
|
@ -122,21 +105,6 @@ PRIVATE>
|
||||||
|
|
||||||
: nth-root ( n x -- y ) swap recip ^ ; inline
|
: 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 )
|
: lcm ( a b -- c )
|
||||||
[ * ] 2keep fast-gcd /i ; foldable
|
[ * ] 2keep fast-gcd /i ; foldable
|
||||||
|
|
||||||
|
|
|
@ -28,6 +28,7 @@ load-help? off
|
||||||
] %
|
] %
|
||||||
|
|
||||||
"math.integers" require
|
"math.integers" require
|
||||||
|
"math.ratios" require
|
||||||
"math.floats" require
|
"math.floats" require
|
||||||
"memory" require
|
"memory" require
|
||||||
|
|
||||||
|
|
|
@ -235,6 +235,19 @@ HELP: sgn
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
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/
|
HELP: 2/
|
||||||
{ $values { "x" integer } { "y" integer } }
|
{ $values { "x" integer } { "y" integer } }
|
||||||
{ $description "Shifts " { $snippet "x" } " to the right by one bit." }
|
{ $description "Shifts " { $snippet "x" } " to the right by one bit." }
|
||||||
|
|
|
@ -98,3 +98,53 @@ IN: math.tests
|
||||||
{ t } [ 128 2^ neg sq 256 2^ = ] unit-test
|
{ t } [ 128 2^ neg sq 256 2^ = ] unit-test
|
||||||
|
|
||||||
{ t } [ most-negative-fixnum dup >bignum bignum>fixnum-strict = ] 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
|
||||||
|
|
|
@ -158,7 +158,9 @@ GENERIC: neg? ( x -- -x )
|
||||||
|
|
||||||
UNION: integer fixnum bignum ;
|
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: rational integer ratio ;
|
||||||
|
|
||||||
|
@ -166,7 +168,9 @@ M: rational neg? 0 < ; inline
|
||||||
|
|
||||||
UNION: real rational float ;
|
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 ;
|
UNION: number real complex ;
|
||||||
|
|
||||||
|
@ -174,6 +178,42 @@ GENERIC: recip ( x -- y )
|
||||||
|
|
||||||
M: number recip 1 swap / ; inline
|
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
|
: fp-bitwise= ( x y -- ? ) [ double>bits ] same? ; inline
|
||||||
|
|
||||||
GENERIC: fp-special? ( x -- ? )
|
GENERIC: fp-special? ( x -- ? )
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel kernel.private math math.functions
|
USING: accessors kernel math ;
|
||||||
math.private sequences summary ;
|
|
||||||
IN: math.ratios
|
IN: math.ratios
|
||||||
|
|
||||||
: 2>fraction ( a/b c/d -- a c b d )
|
: 2>fraction ( a/b c/d -- a c b d )
|
||||||
|
@ -25,9 +24,6 @@ PRIVATE>
|
||||||
|
|
||||||
ERROR: division-by-zero x ;
|
ERROR: division-by-zero x ;
|
||||||
|
|
||||||
M: division-by-zero summary
|
|
||||||
drop "Division by zero" ;
|
|
||||||
|
|
||||||
M: integer /
|
M: integer /
|
||||||
[
|
[
|
||||||
division-by-zero
|
division-by-zero
|
Loading…
Reference in New Issue