math.functions: faster gcd means faster ratios.

db4
John Benediktsson 2011-10-17 20:36:28 -07:00
parent a2804ebf54
commit ac98269f53
5 changed files with 34 additions and 25 deletions

View File

@ -117,46 +117,49 @@ CONSTANT: log10-factorial-1000 HEX: 1.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
: test-gcd ( x y -- z )
[ gcd nip ] [ gcd* ] 2bi [ assert= ] keep ;
[ 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
[ 100 ] [ 100 100 test-gcd ] unit-test
[ 100 ] [ 1000 100 test-gcd ] unit-test
[ 100 ] [ 100 1000 test-gcd ] unit-test
[ 4 ] [ 132 64 test-gcd ] unit-test
[ 4 ] [ -132 64 test-gcd ] unit-test
[ 4 ] [ -132 -64 test-gcd ] unit-test
[ 4 ] [ 132 -64 test-gcd ] unit-test
[ 4 ] [ -132 -64 test-gcd ] unit-test
[ 100 ] [ 100 >bignum 100 >bignum test-gcd ] unit-test
[ 100 ] [ 1000 >bignum 100 >bignum test-gcd ] unit-test
[ 100 ] [ 100 >bignum 1000 >bignum test-gcd ] unit-test
[ 4 ] [ 132 >bignum 64 >bignum test-gcd ] unit-test
[ 4 ] [ -132 >bignum 64 >bignum test-gcd ] unit-test
[ 4 ] [ -132 >bignum -64 >bignum test-gcd ] unit-test
[ 4 ] [ 132 >bignum -64 >bignum test-gcd ] unit-test
[ 4 ] [ -132 >bignum -64 >bignum test-gcd ] unit-test
[ 6 ] [
1326264299060955293181542400000006
1591517158873146351817850880000000
gcd nip
test-gcd
] unit-test
[ 11 ] [
13262642990609552931815424
159151715887314635181785
gcd nip
test-gcd
] unit-test
[ 3 ] [
13262642990609552931
1591517158873146351
gcd nip
test-gcd
] unit-test
[ 26525285981219 ] [
132626429906095
159151715887314
gcd nip
test-gcd
] unit-test

View File

@ -94,7 +94,10 @@ M: complex exp >rect [ exp ] dip polar> ; inline
2nip
] [
swap [ /mod [ over * swapd - ] dip ] keep (gcd)
] if ;
] if ; inline recursive
: (gcd*) ( a b -- c )
[ [ mod ] keep swap (gcd*) ] unless-zero ; inline recursive
PRIVATE>
@ -111,8 +114,11 @@ PRIVATE>
: gcd ( x y -- a d )
[ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable
: gcd* ( a b -- c )
(gcd*) dup 0 < [ neg ] when ; foldable
: lcm ( a b -- c )
[ * ] 2keep gcd nip /i ; foldable
[ * ] 2keep gcd* /i ; foldable
: divisor? ( m n -- ? )
mod 0 = ;

View File

@ -68,7 +68,7 @@ PRIVATE>
: nprimes ( n -- seq ) [ 2 swap [ dup , next-prime ] times ] { } make nip ;
: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
: coprime? ( a b -- ? ) gcd* 1 = ; foldable
: random-prime ( numbits -- p )
[ ] [ 2^ ] [ random-bits* next-prime ] tri

View File

@ -30,7 +30,7 @@ M: integer /
division-by-zero
] [
dup 0 < [ [ neg ] bi@ ] when
2dup gcd nip [ /i ] curry bi@ fraction>
2dup gcd* [ /i ] curry bi@ fraction>
] if-zero ;
M: ratio hashcode*

View File

@ -27,7 +27,7 @@ CONSTANT: public-key 65537
#! Loop until phi is not divisible by the public key.
dup rsa-primes [ * ] 2keep
[ 1 - ] bi@ *
dup public-key gcd nip 1 = [
dup public-key gcd* 1 = [
rot drop
] [
2drop modulus-phi