Merge commit 'origin/master' into emacs

2008-12-27 15:16:21 +01:00 · 2008-12-27 15:16:21 +01:00 · 7d4f4c5ed7
parent 0fc7574f48 6cfb951d82
commit 7d4f4c5ed7
17 changed files with 90 additions and 6512 deletions
--- a/basis/bit-arrays/bit-arrays-tests.factor
+++ b/basis/bit-arrays/bit-arrays-tests.factor
@ -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
 } bit-array>integer ] unit-test
+
+[ 49 ] [ 49 <bit-array> dup set-bits [ ] count ] unit-test
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@ -25,7 +25,7 @@ TUPLE: bit-array

 : (set-bits) ( bit-array n -- )
    [ [ length bits>cells ] keep ] dip swap underlying>>
-    '[ [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
+    '[ 2 shift [ _ _ ] dip set-alien-unsigned-4 ] each ; inline

 PRIVATE>

--- a/basis/math/miller-rabin/miller-rabin.factor
+++ b/basis/math/miller-rabin/miller-rabin.factor
@ -4,9 +4,9 @@ USING: combinators io locals kernel math math.functions
 math.ranges namespaces random sequences hashtables sets ;
 IN: math.miller-rabin

-: >even ( n -- int ) dup even? [ 1- ] unless ; foldable
+<PRIVATE
+
 : >odd ( n -- int ) dup even? [ 1+ ] when ; foldable
-: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;

 TUPLE: positive-even-expected n ;

@ -28,6 +28,10 @@ TUPLE: positive-even-expected n ;
            ] unless drop
        ] each prime? ] ;

+PRIVATE>
+
+: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
+
 : miller-rabin* ( n numtrials -- ? )
    over {
        { [ dup 1 <= ] [ 3drop f ] }
@ -46,11 +50,15 @@ TUPLE: positive-even-expected n ;

 ERROR: no-relative-prime n ;

+<PRIVATE
+
 : (find-relative-prime) ( n guess -- p )
    over 1 <= [ over no-relative-prime ] when
    dup 1 <= [ drop 3 ] when
    2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;

+PRIVATE>
+
 : find-relative-prime* ( n guess -- p )
    #! find a prime relative to n with initial guess
    >odd (find-relative-prime) ;
--- a/core/io/pathnames/pathnames-docs.factor
+++ b/core/io/pathnames/pathnames-docs.factor
@ -65,8 +65,15 @@ HELP: home
 { $values { "dir" string } }
 { $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"
+{ $subsection "pathname-normalization" }
+"Literal pathnames:"
+{ $subsection POSTPONE: P" }
 "Pathname manipulation:"
+{ $subsection normalize-path }
 { $subsection parent-directory }
 { $subsection file-name }
 { $subsection last-path-separator }
--- a/extra/4DNav/4DNav.factor
+++ b/extra/4DNav/4DNav.factor
@ -293,7 +293,7 @@ VAR: present-space
 closed-quot  <roll-button> { 0 0 } >>align ;

 : <list-runner> ( -- gadget )
-    "extra/4DNav" 
+    "resource:extra/4DNav" 
  <pile> 1 >>fill 
    over dup directory-files  
    [ ".xml" tail? ] filter 
--- a/extra/4DNav/file-chooser/file-chooser.factor
+++ b/extra/4DNav/file-chooser/file-chooser.factor
@ -4,6 +4,9 @@ USING:
 kernel
 io.files
 io.backend
+io.directories
+io.files.info
+io.pathnames
 sequences
 models
 strings
@ -23,7 +26,6 @@ prettyprint
 combinators
 rewrite-closures
 accessors
-namespaces.lib
 values
 tools.walker
 fry
--- a/extra/math/erato/erato-docs.factor
+++ b/extra/math/erato/erato-docs.factor
@ -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)." } ;
--- a/extra/math/erato/erato-tests.factor
+++ b/extra/math/erato/erato-tests.factor
@ -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
--- a/extra/math/erato/erato.factor
+++ b/extra/math/erato/erato.factor
@ -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 ;
--- a/extra/math/primes/erato/erato-docs.factor
+++ b/extra/math/primes/erato/erato-docs.factor
@ -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
--- a/extra/math/primes/erato/erato-tests.factor
+++ b/extra/math/primes/erato/erato-tests.factor
@ -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
--- a/extra/math/primes/erato/erato.factor
+++ b/extra/math/primes/erato/erato.factor
@ -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
--- a/extra/math/primes/list/list.factor
+++ b/extra/math/primes/list/list.factor
--- a/extra/math/primes/primes-docs.factor
+++ b/extra/math/primes/primes-docs.factor
@ -4,7 +4,7 @@ IN: math.primes
 { next-prime prime? } related-words

 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" } "." } ;

 HELP: prime?
--- a/extra/math/primes/primes-tests.factor
+++ b/extra/math/primes/primes-tests.factor
@ -8,3 +8,7 @@ USING: arrays math.primes tools.test lists.lazy ;
 { { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test
 { { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test
 { { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test
+
+{ { 4999963 4999999 5000011 5000077 5000081 } }
+[ 4999962 5000082 primes-between >array ]
+unit-test
--- a/extra/math/primes/primes.factor
+++ b/extra/math/primes/primes.factor
@ -1,47 +1,39 @@
 ! Copyright (C) 2007 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 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

 <PRIVATE

-: find-prime-miller-rabin ( n -- p )
-    dup miller-rabin [ 2 + find-prime-miller-rabin ] unless ; foldable
+: look-in-bitmap ( n -- ? ) >index 4999999 sieve nth ;
+
+: really-prime? ( n -- ? )
+    dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable

 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 -- ? )
-    dup 1000000 < [
-        dup primes-under-million natural-search nip =
-    ] [
-        miller-rabin
-    ] if ; foldable
+    {
+        { [ dup 2 < ] [ drop f ] }
+        { [ dup even? ] [ 2 = ] }
+        [ really-prime? ]
+    } cond ; foldable

-: lprimes ( -- list )
-    0 primes-under-million seq>list
-    1000003 [ 2 + find-prime-miller-rabin ] lfrom-by
-    lappend ;
+: next-prime ( n -- p )
+    next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable
+
+: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ;

 : lprimes-from ( n -- list )
    dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ;

 : primes-upto ( n -- seq )
-    {
-        { [ dup 2 < ] [ drop { } ] }
-        { [ dup 1000003 < ] [
-            primes-under-million [ natural-search drop 1+ 0 swap ] keep <slice>
-        ] }
-        [ primes-under-million 1000003 lprimes-from
-            rot [ <= ] curry lwhile list>array append ]
-    } cond ; foldable
+    dup 2 < [
+        drop V{ }
+    ] [
+        3 swap 2 <range> [ prime? ] filter 2 prefix
+    ] if ; foldable

 : primes-between ( low high -- seq )
    primes-upto [ 1- next-prime ] dip
--- a/extra/project-euler/010/010.factor
+++ b/extra/project-euler/010/010.factor
@ -19,10 +19,7 @@ IN: project-euler.010
 : euler010 ( -- answer )
    2000000 primes-upto sum ;

-! [ euler010 ] time
-! 266425 ms run / 10001 ms GC time
-
-! 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
+! [ euler010 ] 100 ave-time
+! 15 ms ave run time - 0.41 SD (100 trials)

 MAIN: euler010