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

Small updates to math.primes

db4
Aaron Schaefer 2008-11-08 16:34:39 -05:00
parent 798139f2e7
commit 774cb858d5
2 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
extra/math/primes/factors/factors.factor
View File

@ -1,7 +1,6 @@
! Copyright (C) 2007 Samuel Tardieu. ! Copyright (C) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel lists math math.primes namespaces make USING: arrays kernel lists make math math.primes sequences ;
sequences ;
IN: math.primes.factors IN: math.primes.factors
<PRIVATE <PRIVATE
@ -11,14 +10,16 @@ IN: math.primes.factors
: (count) ( n d -- n' ) : (count) ( n d -- n' )
[ (factor) ] { } make [ (factor) ] { } make
[ [ first ] keep length 2array , ] unless-empty ; [ [ first ] [ length ] bi 2array , ] unless-empty ;
: (unique) ( n d -- n' ) : (unique) ( n d -- n' )
[ (factor) ] { } make [ (factor) ] { } make
[ first , ] unless-empty ; [ first , ] unless-empty ;
: (factors) ( quot list n -- ) : (factors) ( quot list n -- )
dup 1 > [ swap uncons swap >r pick call r> swap (factors) ] [ 3drop ] if ; dup 1 > [
swap uncons swap [ pick call ] dip swap (factors)
] [ 3drop ] if ;
: (decompose) ( n quot -- seq ) : (decompose) ( n quot -- seq )
[ lprimes rot (factors) ] { } make ; [ lprimes rot (factors) ] { } make ;
@ -38,5 +39,5 @@ PRIVATE>
dup 2 < [ dup 2 < [
drop 0 drop 0
] [ ] [
dup unique-factors dup 1 [ 1- * ] reduce swap product / * dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / *
] if ; foldable ] if ; foldable

10
extra/math/primes/primes.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2007 Samuel Tardieu. ! Copyright (C) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel lists.lazy math math.functions math.miller-rabin USING: binary-search combinators kernel lists.lazy math math.functions
math.order math.primes.list math.ranges sequences sorting math.miller-rabin math.primes.list sequences ;
binary-search ;
IN: math.primes IN: math.primes
<PRIVATE <PRIVATE
@ -45,8 +44,7 @@ PRIVATE>
} cond ; foldable } cond ; foldable
: primes-between ( low high -- seq ) : primes-between ( low high -- seq )
primes-upto primes-upto [ 1- next-prime ] dip
[ 1- next-prime ] dip [ natural-search drop ] [ length ] [ ] tri <slice> ; foldable
[ natural-search drop ] keep [ length ] keep <slice> ; foldable
: coprime? ( a b -- ? ) gcd nip 1 = ; foldable : coprime? ( a b -- ? ) gcd nip 1 = ; foldable