Merge branch 'for-slava' of git://git.rfc1149.net/factor into new_ui

db4
Slava Pestov 2009-01-07 12:14:52 -06:00
commit ff1e15466f
12 changed files with 39 additions and 34 deletions

View File

@ -1,13 +1,17 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: binary-search kernel math.primes.list math.ranges sequences
prettyprint ;
USING: binary-search compiler.units kernel math.primes math.ranges
memoize prettyprint sequences ;
IN: benchmark.binary-search
: binary-search-benchmark ( -- )
1 1000000 [a,b] [ primes-under-million sorted-member? ] map length . ;
[
MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
] with-compilation-unit
! Force computation of the primes list before benchmarking the binary search
primes-under-million drop
: binary-search-benchmark ( -- )
1 1000000 [a,b] [ primes-under-million sorted-member? ] map length . ;
MAIN: binary-search-benchmark

View File

@ -1,10 +1,10 @@
USING: checksums checksums.crc32 io.encodings.ascii io.files kernel math ;
IN: benchmark.crc32
: crc32-primes-list ( -- )
: crc32-file ( -- )
10 [
"resource:extra/math/primes/list/list.factor"
"resource:basis/mime/multipart/multipart-tests.factor"
crc32 checksum-file drop
] times ;
MAIN: crc32-primes-list
MAIN: crc32-file

View File

@ -1,7 +1,7 @@
USING: checksums checksums.md5 io.files kernel ;
IN: benchmark.md5
: md5-primes-list ( -- )
"resource:extra/math/primes/list/list.factor" md5 checksum-file drop ;
: md5-file ( -- )
"resource:basis/mime/multipart/multipart-tests.factor" md5 checksum-file drop ;
MAIN: md5-primes-list
MAIN: md5-file

View File

@ -1,7 +1,7 @@
USING: checksums checksums.sha1 io.files kernel ;
IN: benchmark.sha1
: sha1-primes-list ( -- )
"resource:extra/math/primes/list/list.factor" sha1 checksum-file drop ;
: sha1-file ( -- )
"resource:basis/mime/multipart/multipart-tests.factor" sha1 checksum-file drop ;
MAIN: sha1-primes-list
MAIN: sha1-file

View File

@ -0,0 +1 @@
Samuel Tardieu

View File

@ -1,3 +1,5 @@
! Copyright (C) 2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: bit-arrays kernel math math.functions math.ranges sequences ;
IN: math.primes.erato

View File

@ -0,0 +1 @@
Eratosthene sieve

View File

@ -1,6 +1,8 @@
USING: math.primes.factors tools.test ;
{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
{ { } } [ -5 factors ] unit-test
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test
{ 0 } [ 1 totient ] unit-test

View File

@ -1,39 +1,36 @@
! Copyright (C) 2007 Samuel Tardieu.
! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel lists make math math.primes sequences ;
IN: math.primes.factors
<PRIVATE
: (factor) ( n d -- n' )
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
: count-factor ( n d -- n' c )
0 [ [ 2dup mod zero? ] dip swap ] [ [ [ / ] keep ] dip 1+ ] [ ] while nip ;
: (factor) ( n d -- n' ) dup [ , ] curry [ count-factor ] dip times ;
: (count) ( n d -- n' )
[ (factor) ] { } make
[ [ first ] [ length ] bi 2array , ] unless-empty ;
dup [ swap 2array , ] curry
[ count-factor dup zero? [ drop ] ] dip if ;
: (unique) ( n d -- n' )
[ (factor) ] { } make
[ first , ] unless-empty ;
dup [ , ] curry [ count-factor zero? ] dip unless ;
: (factors) ( quot list n -- )
dup 1 > [
swap uncons swap [ pick call ] dip swap (factors)
] [ 3drop ] if ;
] [ 3drop ] if ; inline recursive
: (decompose) ( n quot -- seq )
[ lprimes rot (factors) ] { } make ;
: decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline
PRIVATE>
: factors ( n -- seq )
[ (factor) ] (decompose) ; foldable
: factors ( n -- seq ) [ (factor) ] decompose ; flushable
: group-factors ( n -- seq )
[ (count) ] (decompose) ; foldable
: group-factors ( n -- seq ) [ (count) ] decompose ; flushable
: unique-factors ( n -- seq )
[ (unique) ] (decompose) ; foldable
: unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable
: totient ( n -- t )
dup 2 < [

View File

@ -1 +0,0 @@
Doug Coleman

View File

@ -1,4 +0,0 @@
USING: math.primes memoize ;
IN: math.primes.list
MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;

View File

@ -0,0 +1,3 @@
USING: project-euler.057 tools.test ;
{ 153 } [ euler057 ] unit-test