math.ratios: moving to core.

db4
John Benediktsson 2015-07-30 09:41:58 -07:00
parent 465dc8d231
commit c6fad4aa61
13 changed files with 115 additions and 106 deletions

View File

@ -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" ;

View File

@ -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" } "." }

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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." }

View File

@ -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

View File

@ -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 -- ? )

View File

@ -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