From c6fad4aa616b99a46dd49fe8ec65ab7a90f607d8 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 30 Jul 2015 09:41:58 -0700 Subject: [PATCH] math.ratios: moving to core. --- basis/debugger/debugger.factor | 12 +++-- basis/math/functions/functions-docs.factor | 13 ----- basis/math/functions/functions-tests.factor | 50 ------------------- basis/math/functions/functions.factor | 32 ------------ core/bootstrap/stage1.factor | 1 + core/math/math-docs.factor | 13 +++++ core/math/math-tests.factor | 50 +++++++++++++++++++ core/math/math.factor | 44 +++++++++++++++- {basis => core}/math/ratios/authors.txt | 0 .../math/ratios/ratios-docs.factor | 0 .../math/ratios/ratios-tests.factor | 0 {basis => core}/math/ratios/ratios.factor | 6 +-- {basis => core}/math/ratios/summary.txt | 0 13 files changed, 115 insertions(+), 106 deletions(-) rename {basis => core}/math/ratios/authors.txt (100%) rename {basis => core}/math/ratios/ratios-docs.factor (100%) rename {basis => core}/math/ratios/ratios-tests.factor (100%) rename {basis => core}/math/ratios/ratios.factor (92%) rename {basis => core}/math/ratios/summary.txt (100%) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index bac63016ee..2fe87b4b8f 100755 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -6,10 +6,11 @@ combinators combinators.short-circuit compiler.errors 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 @@ -190,6 +191,9 @@ M: vm-error error. dup vm-errors dispatch ; 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" ; diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index 32efeaa52c..146204db0e 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -95,14 +95,6 @@ ARTICLE: "math-functions" "Mathematical 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 { $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" } "." } @@ -280,11 +272,6 @@ HELP: 10^ { $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" } "." } diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index b772c1aa0d..0dec2a7345 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -127,56 +127,6 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11 { 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 diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 6b1382fa1a..22e07db984 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -4,10 +4,6 @@ USING: math kernel math.constants math.private math.bits 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 @@ -55,12 +51,6 @@ M: complex ^n (^n) ; 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 @@ -103,13 +93,6 @@ M: complex e^ >rect [ e^ ] dip polar> ; 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 ) @@ -122,21 +105,6 @@ PRIVATE> : 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 - - - -M: real fast-gcd simple-gcd ; inline - -M: bignum fast-gcd bignum-gcd ; inline - : lcm ( a b -- c ) [ * ] 2keep fast-gcd /i ; foldable diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index 589378a309..fd176d1376 100644 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -28,6 +28,7 @@ load-help? off ] % "math.integers" require + "math.ratios" require "math.floats" require "memory" require diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 85f21badb4..96c63cb0fe 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -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/ { $values { "x" integer } { "y" integer } } { $description "Shifts " { $snippet "x" } " to the right by one bit." } diff --git a/core/math/math-tests.factor b/core/math/math-tests.factor index ef7a8438d8..d748750259 100644 --- a/core/math/math-tests.factor +++ b/core/math/math-tests.factor @@ -98,3 +98,53 @@ IN: math.tests { 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 diff --git a/core/math/math.factor b/core/math/math.factor index 5a0ba2fd46..ecf3e43001 100644 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -158,7 +158,9 @@ GENERIC: neg? ( x -- -x ) 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 ; @@ -166,7 +168,9 @@ M: rational neg? 0 < ; inline 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 ; @@ -174,6 +178,42 @@ GENERIC: recip ( x -- y ) 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 + + + +: gcd ( x y -- a d ) + [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; inline + +MATH: fast-gcd ( x y -- d ) foldable + + + +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 -- ? ) diff --git a/basis/math/ratios/authors.txt b/core/math/ratios/authors.txt similarity index 100% rename from basis/math/ratios/authors.txt rename to core/math/ratios/authors.txt diff --git a/basis/math/ratios/ratios-docs.factor b/core/math/ratios/ratios-docs.factor similarity index 100% rename from basis/math/ratios/ratios-docs.factor rename to core/math/ratios/ratios-docs.factor diff --git a/basis/math/ratios/ratios-tests.factor b/core/math/ratios/ratios-tests.factor similarity index 100% rename from basis/math/ratios/ratios-tests.factor rename to core/math/ratios/ratios-tests.factor diff --git a/basis/math/ratios/ratios.factor b/core/math/ratios/ratios.factor similarity index 92% rename from basis/math/ratios/ratios.factor rename to core/math/ratios/ratios.factor index 5d693ec5e7..167d335b9b 100644 --- a/basis/math/ratios/ratios.factor +++ b/core/math/ratios/ratios.factor @@ -1,7 +1,6 @@ ! 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 ; +USING: accessors kernel math ; IN: math.ratios : 2>fraction ( a/b c/d -- a c b d ) @@ -25,9 +24,6 @@ PRIVATE> ERROR: division-by-zero x ; -M: division-by-zero summary - drop "Division by zero" ; - M: integer / [ division-by-zero diff --git a/basis/math/ratios/summary.txt b/core/math/ratios/summary.txt similarity index 100% rename from basis/math/ratios/summary.txt rename to core/math/ratios/summary.txt