Merge commit 'origin/master' into emacs
commit
7d4f4c5ed7
|
@ -76,3 +76,5 @@ IN: bit-arrays.tests
|
||||||
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
|
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
|
||||||
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
|
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
|
||||||
} bit-array>integer ] unit-test
|
} bit-array>integer ] unit-test
|
||||||
|
|
||||||
|
[ 49 ] [ 49 <bit-array> dup set-bits [ ] count ] unit-test
|
||||||
|
|
|
@ -25,7 +25,7 @@ TUPLE: bit-array
|
||||||
|
|
||||||
: (set-bits) ( bit-array n -- )
|
: (set-bits) ( bit-array n -- )
|
||||||
[ [ length bits>cells ] keep ] dip swap underlying>>
|
[ [ length bits>cells ] keep ] dip swap underlying>>
|
||||||
'[ [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
|
'[ 2 shift [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -4,9 +4,9 @@ USING: combinators io locals kernel math math.functions
|
||||||
math.ranges namespaces random sequences hashtables sets ;
|
math.ranges namespaces random sequences hashtables sets ;
|
||||||
IN: math.miller-rabin
|
IN: math.miller-rabin
|
||||||
|
|
||||||
: >even ( n -- int ) dup even? [ 1- ] unless ; foldable
|
<PRIVATE
|
||||||
|
|
||||||
: >odd ( n -- int ) dup even? [ 1+ ] when ; foldable
|
: >odd ( n -- int ) dup even? [ 1+ ] when ; foldable
|
||||||
: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
|
|
||||||
|
|
||||||
TUPLE: positive-even-expected n ;
|
TUPLE: positive-even-expected n ;
|
||||||
|
|
||||||
|
@ -28,6 +28,10 @@ TUPLE: positive-even-expected n ;
|
||||||
] unless drop
|
] unless drop
|
||||||
] each prime? ] ;
|
] each prime? ] ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
|
||||||
|
|
||||||
: miller-rabin* ( n numtrials -- ? )
|
: miller-rabin* ( n numtrials -- ? )
|
||||||
over {
|
over {
|
||||||
{ [ dup 1 <= ] [ 3drop f ] }
|
{ [ dup 1 <= ] [ 3drop f ] }
|
||||||
|
@ -46,11 +50,15 @@ TUPLE: positive-even-expected n ;
|
||||||
|
|
||||||
ERROR: no-relative-prime n ;
|
ERROR: no-relative-prime n ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
: (find-relative-prime) ( n guess -- p )
|
: (find-relative-prime) ( n guess -- p )
|
||||||
over 1 <= [ over no-relative-prime ] when
|
over 1 <= [ over no-relative-prime ] when
|
||||||
dup 1 <= [ drop 3 ] when
|
dup 1 <= [ drop 3 ] when
|
||||||
2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;
|
2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: find-relative-prime* ( n guess -- p )
|
: find-relative-prime* ( n guess -- p )
|
||||||
#! find a prime relative to n with initial guess
|
#! find a prime relative to n with initial guess
|
||||||
>odd (find-relative-prime) ;
|
>odd (find-relative-prime) ;
|
||||||
|
|
|
@ -65,8 +65,15 @@ HELP: home
|
||||||
{ $values { "dir" string } }
|
{ $values { "dir" string } }
|
||||||
{ $description "Outputs the user's home directory." } ;
|
{ $description "Outputs the user's home directory." } ;
|
||||||
|
|
||||||
|
ARTICLE: "pathname-normalization" "Pathname normalization"
|
||||||
|
"Words that take a pathname should normalize the pathname by calling " { $link normalize-path } ".When normalizing a pathname, the input pathname is either absolute or relative to the " { $link current-directory } ". If absolute, such as the root directories " { $snippet "/" } " or " { $snippet "c:\\" } ", the pathname is left alone, while if relative, the current directory is prepended to the pathname. If a pathname begins with the magic string " { $snippet "resource:" } ", this string is replaced with the Factor directory. On Windows, all pathnames, absolute and relative, are converted to Unicode pathamess." ;
|
||||||
|
|
||||||
ARTICLE: "io.pathnames" "Pathname manipulation"
|
ARTICLE: "io.pathnames" "Pathname manipulation"
|
||||||
|
{ $subsection "pathname-normalization" }
|
||||||
|
"Literal pathnames:"
|
||||||
|
{ $subsection POSTPONE: P" }
|
||||||
"Pathname manipulation:"
|
"Pathname manipulation:"
|
||||||
|
{ $subsection normalize-path }
|
||||||
{ $subsection parent-directory }
|
{ $subsection parent-directory }
|
||||||
{ $subsection file-name }
|
{ $subsection file-name }
|
||||||
{ $subsection last-path-separator }
|
{ $subsection last-path-separator }
|
||||||
|
|
|
@ -293,7 +293,7 @@ VAR: present-space
|
||||||
closed-quot <roll-button> { 0 0 } >>align ;
|
closed-quot <roll-button> { 0 0 } >>align ;
|
||||||
|
|
||||||
: <list-runner> ( -- gadget )
|
: <list-runner> ( -- gadget )
|
||||||
"extra/4DNav"
|
"resource:extra/4DNav"
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
over dup directory-files
|
over dup directory-files
|
||||||
[ ".xml" tail? ] filter
|
[ ".xml" tail? ] filter
|
||||||
|
|
|
@ -4,6 +4,9 @@ USING:
|
||||||
kernel
|
kernel
|
||||||
io.files
|
io.files
|
||||||
io.backend
|
io.backend
|
||||||
|
io.directories
|
||||||
|
io.files.info
|
||||||
|
io.pathnames
|
||||||
sequences
|
sequences
|
||||||
models
|
models
|
||||||
strings
|
strings
|
||||||
|
@ -23,7 +26,6 @@ prettyprint
|
||||||
combinators
|
combinators
|
||||||
rewrite-closures
|
rewrite-closures
|
||||||
accessors
|
accessors
|
||||||
namespaces.lib
|
|
||||||
values
|
values
|
||||||
tools.walker
|
tools.walker
|
||||||
fry
|
fry
|
||||||
|
|
|
@ -1,6 +0,0 @@
|
||||||
USING: help.markup help.syntax ;
|
|
||||||
IN: math.erato
|
|
||||||
|
|
||||||
HELP: lerato
|
|
||||||
{ $values { "n" "a positive number" } { "lazy-list" "a lazy prime numbers generator" } }
|
|
||||||
{ $description "Builds a lazy list containing the prime numbers between 2 and " { $snippet "n" } " (inclusive)." } ;
|
|
|
@ -1,6 +0,0 @@
|
||||||
! Copyright (c) 2007 Samuel Tardieu.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: lists.lazy math.erato tools.test ;
|
|
||||||
IN: math.erato.tests
|
|
||||||
|
|
||||||
[ { 2 3 5 7 11 13 17 19 } ] [ 20 lerato list>array ] unit-test
|
|
|
@ -1,43 +0,0 @@
|
||||||
! Copyright (c) 2007 Samuel Tardieu.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: accessors bit-arrays fry kernel lists.lazy math math.functions
|
|
||||||
math.primes.list math.ranges sequences ;
|
|
||||||
IN: math.erato
|
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
TUPLE: erato limit bits latest ;
|
|
||||||
|
|
||||||
: ind ( n -- i )
|
|
||||||
2/ 1- ; inline
|
|
||||||
|
|
||||||
: is-prime ( n limit -- bool )
|
|
||||||
[ ind ] [ bits>> ] bi* nth ; inline
|
|
||||||
|
|
||||||
: indices ( n erato -- range )
|
|
||||||
limit>> ind over 3 * ind spin <range> ;
|
|
||||||
|
|
||||||
: mark-multiples ( n erato -- )
|
|
||||||
2dup [ sq ] [ limit>> ] bi* <= [
|
|
||||||
[ indices ] keep bits>> '[ _ f -rot set-nth ] each
|
|
||||||
] [ 2drop ] if ;
|
|
||||||
|
|
||||||
: <erato> ( n -- erato )
|
|
||||||
dup ind 1+ <bit-array> dup set-bits 1 erato boa ;
|
|
||||||
|
|
||||||
: next-prime ( erato -- prime/f )
|
|
||||||
[ 2 + ] change-latest [ latest>> ] keep
|
|
||||||
2dup limit>> <= [
|
|
||||||
2dup is-prime [ dupd mark-multiples ] [ nip next-prime ] if
|
|
||||||
] [
|
|
||||||
2drop f
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
: lerato ( n -- lazy-list )
|
|
||||||
dup 1000003 < [
|
|
||||||
0 primes-under-million seq>list swap '[ _ <= ] lwhile
|
|
||||||
] [
|
|
||||||
<erato> 2 [ drop next-prime ] with lfrom-by [ ] lwhile
|
|
||||||
] if ;
|
|
|
@ -0,0 +1,12 @@
|
||||||
|
USING: help.markup help.syntax ;
|
||||||
|
IN: math.primes.erato
|
||||||
|
|
||||||
|
HELP: sieve
|
||||||
|
{ $values { "n" "the greatest odd number to consider" } { "arr" "a bit array" } }
|
||||||
|
{ $description "Return a bit array containing a primality bit for every odd number between 3 and " { $snippet "n" } " (inclusive). " { $snippet ">index" } " can be used to retrieve the index of an odd number to be tested." } ;
|
||||||
|
|
||||||
|
HELP: >index
|
||||||
|
{ $values { "n" "an odd number" } { "i" "the corresponding index" } }
|
||||||
|
{ $description "Retrieve the index corresponding to the odd number on the stack." } ;
|
||||||
|
|
||||||
|
{ sieve >index } related-words
|
|
@ -0,0 +1,3 @@
|
||||||
|
USING: bit-arrays math.primes.erato tools.test ;
|
||||||
|
|
||||||
|
[ ?{ t t t f t t f t t f t f f t } ] [ 29 sieve ] unit-test
|
|
@ -0,0 +1,23 @@
|
||||||
|
USING: bit-arrays kernel math math.functions math.ranges sequences ;
|
||||||
|
IN: math.primes.erato
|
||||||
|
|
||||||
|
: >index ( n -- i )
|
||||||
|
3 - 2 /i ; inline
|
||||||
|
|
||||||
|
: index> ( i -- n )
|
||||||
|
2 * 3 + ; inline
|
||||||
|
|
||||||
|
: mark-multiples ( i arr -- )
|
||||||
|
[ dup index> [ + ] keep ] dip
|
||||||
|
[ length 1 - swap <range> f swap ] keep
|
||||||
|
[ set-nth ] curry with each ;
|
||||||
|
|
||||||
|
: maybe-mark-multiples ( i arr -- )
|
||||||
|
2dup nth [ mark-multiples ] [ 2drop ] if ;
|
||||||
|
|
||||||
|
: init-sieve ( n -- arr )
|
||||||
|
>index 1 + <bit-array> dup set-bits ;
|
||||||
|
|
||||||
|
: sieve ( n -- arr )
|
||||||
|
[ init-sieve ] [ sqrt >index [0,b] ] bi
|
||||||
|
over [ maybe-mark-multiples ] curry each ; foldable
|
File diff suppressed because it is too large
Load Diff
|
@ -4,7 +4,7 @@ IN: math.primes
|
||||||
{ next-prime prime? } related-words
|
{ next-prime prime? } related-words
|
||||||
|
|
||||||
HELP: next-prime
|
HELP: next-prime
|
||||||
{ $values { "n" "a positive integer" } { "p" "a prime number" } }
|
{ $values { "n" "an integer not smaller than 2" } { "p" "a prime number" } }
|
||||||
{ $description "Return the next prime number greater than " { $snippet "n" } "." } ;
|
{ $description "Return the next prime number greater than " { $snippet "n" } "." } ;
|
||||||
|
|
||||||
HELP: prime?
|
HELP: prime?
|
||||||
|
|
|
@ -8,3 +8,7 @@ USING: arrays math.primes tools.test lists.lazy ;
|
||||||
{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test
|
{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test
|
||||||
{ { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test
|
{ { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test
|
||||||
{ { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test
|
{ { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test
|
||||||
|
|
||||||
|
{ { 4999963 4999999 5000011 5000077 5000081 } }
|
||||||
|
[ 4999962 5000082 primes-between >array ]
|
||||||
|
unit-test
|
||||||
|
|
|
@ -1,47 +1,39 @@
|
||||||
! 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: binary-search combinators kernel lists.lazy math math.functions
|
USING: binary-search combinators kernel lists.lazy math math.functions
|
||||||
math.miller-rabin math.primes.list sequences ;
|
math.miller-rabin math.primes.erato math.ranges sequences ;
|
||||||
IN: math.primes
|
IN: math.primes
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: find-prime-miller-rabin ( n -- p )
|
: look-in-bitmap ( n -- ? ) >index 4999999 sieve nth ;
|
||||||
dup miller-rabin [ 2 + find-prime-miller-rabin ] unless ; foldable
|
|
||||||
|
: really-prime? ( n -- ? )
|
||||||
|
dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: next-prime ( n -- p )
|
|
||||||
dup 999983 < [
|
|
||||||
primes-under-million [ natural-search drop 1+ ] keep nth
|
|
||||||
] [
|
|
||||||
next-odd find-prime-miller-rabin
|
|
||||||
] if ; foldable
|
|
||||||
|
|
||||||
: prime? ( n -- ? )
|
: prime? ( n -- ? )
|
||||||
dup 1000000 < [
|
{
|
||||||
dup primes-under-million natural-search nip =
|
{ [ dup 2 < ] [ drop f ] }
|
||||||
] [
|
{ [ dup even? ] [ 2 = ] }
|
||||||
miller-rabin
|
[ really-prime? ]
|
||||||
] if ; foldable
|
} cond ; foldable
|
||||||
|
|
||||||
: lprimes ( -- list )
|
: next-prime ( n -- p )
|
||||||
0 primes-under-million seq>list
|
next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable
|
||||||
1000003 [ 2 + find-prime-miller-rabin ] lfrom-by
|
|
||||||
lappend ;
|
: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ;
|
||||||
|
|
||||||
: lprimes-from ( n -- list )
|
: lprimes-from ( n -- list )
|
||||||
dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ;
|
dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ;
|
||||||
|
|
||||||
: primes-upto ( n -- seq )
|
: primes-upto ( n -- seq )
|
||||||
{
|
dup 2 < [
|
||||||
{ [ dup 2 < ] [ drop { } ] }
|
drop V{ }
|
||||||
{ [ dup 1000003 < ] [
|
] [
|
||||||
primes-under-million [ natural-search drop 1+ 0 swap ] keep <slice>
|
3 swap 2 <range> [ prime? ] filter 2 prefix
|
||||||
] }
|
] if ; foldable
|
||||||
[ primes-under-million 1000003 lprimes-from
|
|
||||||
rot [ <= ] curry lwhile list>array append ]
|
|
||||||
} cond ; foldable
|
|
||||||
|
|
||||||
: primes-between ( low high -- seq )
|
: primes-between ( low high -- seq )
|
||||||
primes-upto [ 1- next-prime ] dip
|
primes-upto [ 1- next-prime ] dip
|
||||||
|
|
|
@ -19,10 +19,7 @@ IN: project-euler.010
|
||||||
: euler010 ( -- answer )
|
: euler010 ( -- answer )
|
||||||
2000000 primes-upto sum ;
|
2000000 primes-upto sum ;
|
||||||
|
|
||||||
! [ euler010 ] time
|
! [ euler010 ] 100 ave-time
|
||||||
! 266425 ms run / 10001 ms GC time
|
! 15 ms ave run time - 0.41 SD (100 trials)
|
||||||
|
|
||||||
! TODO: this takes well over one minute now that they changed the problem to
|
|
||||||
! two million instead of one. the primes vocab could use some improvements
|
|
||||||
|
|
||||||
MAIN: euler010
|
MAIN: euler010
|
||||||
|
|
Loading…
Reference in New Issue