steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
basis/math/functions/functions-tests.factor
View File

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

12
basis/math/functions/functions.factor
View File

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

2
basis/math/primes/primes.factor
View File

@ -68,7 +68,7 @@ PRIVATE>
: nprimes ( n -- seq ) [ 2 swap [ dup , next-prime ] times ] { } make nip ; : 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 ) : random-prime ( numbits -- p )
[ ] [ 2^ ] [ random-bits* next-prime ] tri [ ] [ 2^ ] [ random-bits* next-prime ] tri

2
basis/math/ratios/ratios.factor
View File

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

6
extra/crypto/rsa/rsa.factor
View File

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