math.functions: when gcd is inlined, "gcd nip" is almost as good as "gcd*".

db4
John Benediktsson 2011-10-18 10:30:39 -07:00
parent 5c694767cd
commit cf54ce8e42
5 changed files with 28 additions and 37 deletions

View File

@ -117,49 +117,46 @@ 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
: test-gcd ( x y -- z )
[ gcd nip ] [ gcd* ] 2bi [ assert= ] keep ;
[ 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 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
[ 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
test-gcd
gcd nip
] unit-test
[ 11 ] [
13262642990609552931815424
159151715887314635181785
test-gcd
gcd nip
] unit-test
[ 3 ] [
13262642990609552931
1591517158873146351
test-gcd
gcd nip
] unit-test
[ 26525285981219 ] [
132626429906095
159151715887314
test-gcd
gcd nip
] unit-test

View File

@ -96,9 +96,6 @@ M: complex exp >rect [ exp ] dip polar> ; inline
swap [ /mod [ over * swapd - ] dip ] keep (gcd)
] if ; inline recursive
: (gcd*) ( a b -- c )
[ [ mod ] keep swap (gcd*) ] unless-zero ; inline recursive
PRIVATE>
: ^ ( x y -- z )
@ -112,16 +109,13 @@ PRIVATE>
: nth-root ( n x -- y ) swap recip ^ ; inline
: gcd ( x y -- a d )
[ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable
: gcd* ( x y -- d )
(gcd*) dup 0 < [ neg ] when ; foldable
[ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable inline
: lcm ( a b -- c )
[ * ] 2keep gcd* /i ; foldable
[ * ] 2keep gcd nip /i ; foldable
: divisor? ( m n -- ? )
mod 0 = ;
mod 0 = ; inline
ERROR: non-trivial-divisor n ;

View File

@ -68,7 +68,7 @@ PRIVATE>
: nprimes ( n -- seq ) [ 2 swap [ dup , next-prime ] times ] { } make nip ;
: coprime? ( a b -- ? ) gcd* 1 = ; foldable
: coprime? ( a b -- ? ) gcd nip 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* [ /i ] curry bi@ fraction>
2dup gcd nip [ /i ] curry bi@ fraction>
] if-zero ;
M: ratio hashcode*

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: math.primes kernel math math.functions namespaces
sequences accessors ;
USING: math.primes kernel math math.functions math.primes
namespaces sequences accessors ;
IN: crypto.rsa
! The private key is the only secret.
@ -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* 1 = [
dup public-key coprime? [
rot drop
] [
2drop modulus-phi