Merge commit 'elasticdog/master'

core/io/crc32/crc32.factor

@@ -27,4 +27,4 @@ DEFER: crc32-table inline
 : crc32 ( seq -- n )
     >r HEX: ffffffff dup r> [ (crc32) ] each bitxor ;
 
-: file-crc32 ( path -- n ) <file-reader> contents crc32 ;
+: file-crc32 ( path -- n ) file-contents crc32 ;

core/io/files/files-tests.factor

@@ -23,11 +23,11 @@ USING: tools.test io.files io threads kernel ;
 ] unit-test
 
 [ "Hello world.\nHello appender.\n" ] [
-    "test-foo.txt" resource-path <file-reader> contents
+    "test-foo.txt" resource-path file-contents
 ] unit-test
 
 [ "Hello appender.\n" ] [
-    "test-bar.txt" resource-path <file-reader> contents
+    "test-bar.txt" resource-path file-contents
 ] unit-test
 
 [ ] [ "test-foo.txt" resource-path delete-file ] unit-test

core/io/io.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: hashtables generic kernel math namespaces sequences strings
+    continuations assocs io.files io.styles sbufs ;
 IN: io
-USING: hashtables generic kernel math namespaces
-sequences strings continuations assocs io.styles sbufs ;
 
 GENERIC: stream-close ( stream -- )
 GENERIC: set-timeout ( n stream -- )
@@ -90,3 +90,6 @@ SYMBOL: stdio
 
 : contents ( stream -- str )
     2048 <sbuf> [ stream-copy ] keep >string ;
+
+: file-contents ( path -- str )
+    dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;

core/source-files/source-files.factor

@@ -63,7 +63,7 @@ uses definitions ;
 : reset-checksums ( -- )
     source-files get [
         swap ?resource-path dup exists?
-        [ <file-reader> contents record-checksum ] [ 2drop ] if
+        [ file-contents record-checksum ] [ 2drop ] if
     ] assoc-each ;
 
 M: pathname where pathname-string 1 2array ;

extra/cryptlib/cryptlib-tests.factor

@@ -151,8 +151,8 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
 [
     ! envelope
     CRYPT_FORMAT_CRYPTLIB [
-        "extra/cryptlib/test/large_data.txt" resource-path <file-reader>
+        "extra/cryptlib/test/large_data.txt" resource-path
-        contents set-pop-buffer
+        file-contents set-pop-buffer
         envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE
         get-pop-buffer alien>char-string length 10000 + set-attribute
         envelope-handle CRYPT_ENVINFO_DATASIZE
@@ -192,7 +192,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ;
     CRYPT_FORMAT_CRYPTLIB [
         envelope-handle CRYPT_ENVINFO_PASSWORD "password" set-attribute-string
         "extra/cryptlib/test/large_data.txt" resource-path
-        <file-reader> contents set-pop-buffer
+        file-contents set-pop-buffer
         envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE
         get-pop-buffer alien>char-string length 10000 + set-attribute
         envelope-handle CRYPT_ENVINFO_DATASIZE

extra/html/parser/analyzer/analyzer.factor

@@ -81,11 +81,11 @@ IN: html.parser.analyzer
     ! ] if ;
 
 
-! clear "/Users/erg/web/fark.html" <file-reader> contents parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
+! clear "/Users/erg/web/fark.html" file-contents parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
 ! clear "http://fark.com" http-get parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
 
-! clear "/Users/erg/web/hostels.html" <file-reader> contents parse-html "Currency" "name" pick find-first-attribute-key-value
+! clear "/Users/erg/web/hostels.html" file-contents parse-html "Currency" "name" pick find-first-attribute-key-value
 
-! clear "/Users/erg/web/hostels.html" <file-reader> contents parse-html
+! clear "/Users/erg/web/hostels.html" file-contents parse-html
 ! "Currency" "name" pick find-first-attribute-key-value
 ! pick find-between remove-blank-text

extra/http/server/templating/templating-tests.factor

@@ -1,18 +1,14 @@
-USING: io io.files io.streams.string http.server.templating 
+USING: io io.files io.streams.string http.server.templating kernel tools.test
-kernel tools.test sequences ;
+    sequences ;
 IN: temporary
 
 : test-template ( path -- ? )
     "extra/http/server/templating/test/" swap append
-    
     [
         ".fhtml" append resource-path
         [ run-template-file ] string-out
     ] keep
-
+    ".html" append resource-path file-contents = ;
-    ".html" append resource-path
-    <file-reader> contents
-    = ;
 
 [ t ] [ "example" test-template ] unit-test
 [ t ] [ "bug" test-template ] unit-test

extra/http/server/templating/templating.factor

@@ -82,7 +82,7 @@ DEFER: <% delimiter
             templating-vocab use+
             dup source-file file set ! so that reload works properly
             [
-                ?resource-path <file-reader> contents
+                ?resource-path file-contents
                 [ eval-template ] [ html-error. drop ] recover
             ] keep
         ] with-scope

extra/icfp/2006/2006.factor

@@ -1,9 +1,7 @@
 ! Copyright (C) 2007 Gavin Harrison
 ! See http://factorcode.org/license.txt for BSD license.
-
+USING: kernel math sequences kernel.private namespaces arrays io io.files
-USING: kernel math sequences kernel.private namespaces arrays
+    splitting io.binary math.functions vectors quotations combinators.private ;
-io io.files splitting io.binary math.functions vectors
-quotations combinators.private ;
 IN: icfp.2006
 
 SYMBOL: regs
@@ -129,7 +127,7 @@ SYMBOL: open-arrays
     [ run-op exec-loop ] unless ;
 
 : load-platters ( path -- )
-    <file-reader> contents 4 group [ be> ] map
+    file-contents 4 group [ be> ] map
     0 arrays get set-nth ;
 
 : init ( path -- )

extra/io/mmap/mmap-tests.factor

@@ -1,11 +1,9 @@
-USING: io io.mmap io.files kernel tools.test continuations
+USING: io io.mmap io.files kernel tools.test continuations sequences ;
-sequences ;
 IN: temporary
 
 [ "mmap-test-file.txt" resource-path delete-file ] catch drop
 [ ] [ "mmap-test-file.txt" resource-path <file-writer> [ "12345" write ] with-stream ] unit-test
 [ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
 [ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test
-[ "22345" ] [ "mmap-test-file.txt" resource-path <file-reader> contents ] unit-test
+[ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test
 [ "mmap-test-file.txt" resource-path delete-file ] catch drop
-

extra/mad/api/api.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Adam Wendt.
 ! See http://factorcode.org/license.txt for BSD license.
-!
+USING: alien alien.c-types byte-arrays io io.binary io.files kernel mad
-USING: alien alien.c-types byte-arrays io io.binary io.files kernel mad namespaces prettyprint sbufs sequences tools.interpreter vars ;
+    namespaces prettyprint sbufs sequences tools.interpreter vars ;
 IN: mad.api
 
 VARS: buffer-start buffer-length output-callback-var ;
@@ -80,11 +80,8 @@ VARS: buffer-start buffer-length output-callback-var ;
 : make-decoder ( -- decoder )
   "mad_decoder" malloc-object ;
 
-: file-contents ( path -- string )
-  dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >byte-array ;
-
 : malloc-file-contents ( path -- alien )
-  file-contents malloc-byte-array ;
+  file-contents >byte-array malloc-byte-array ;
 
 : mad-run ( -- int )
   make-decoder [ mad-init ] keep MAD_DECODER_MODE_SYNC mad_decoder_run ;
@@ -98,4 +95,3 @@ VARS: buffer-start buffer-length output-callback-var ;
 : mad-test ( -- results )
   [ output-stdout ] >output-callback-var
   "/home/adam/download/mp3/Misc/wutbf.mp3" decode-mp3 ;
-

extra/project-euler/010/010.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math.primes sequences ;
+USING: kernel math.primes sequences ;
 IN: project-euler.010
 
 ! http://projecteuler.net/index.php?section=problems&id=10
@@ -16,10 +16,8 @@ IN: project-euler.010
 ! SOLUTION
 ! --------
 
-! Summing of prime numbers
-
 : euler010 ( -- answer )
-  1000000 primes-upto sum ;
+    1000000 primes-upto sum ;
 
 ! [ euler010 ] 100 ave-time
 ! 14 ms run / 0 ms GC ave time - 100 trials

extra/project-euler/016/016.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.functions math.parser sequences ;
+USING: kernel math.functions math.parser project-euler.common sequences ;
 IN: project-euler.016
 
 ! http://projecteuler.net/index.php?section=problems&id=16
@@ -16,9 +16,6 @@ IN: project-euler.016
 ! SOLUTION
 ! --------
 
-: number>digits ( n -- seq )
-    number>string string>digits ;
-
 : euler016 ( -- answer )
     2 1000 ^ number>digits sum ;
 

extra/project-euler/017/017.factor

@@ -1,6 +1,7 @@
-! Copyright (c) 2007 Samuel Tardieu.
+! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math namespaces sequences strings ;
+USING: combinators.lib kernel math math.ranges math.text namespaces sequences
+    strings ;
 IN: project-euler.017
 
 ! http://projecteuler.net/index.php?section=problems&id=17
@@ -18,6 +19,7 @@ IN: project-euler.017
 ! forty-two) contains 23 letters and 115 (one hundred and fifteen) contains
 ! 20 letters.
 
+
 ! SOLUTION
 ! --------
 
@@ -38,18 +40,18 @@ IN: project-euler.017
 DEFER: make-english
 
 : maybe-add ( n sep -- )
-  over 0 = [ 2drop ] [ % make-english ] if ;
+  over zero? [ 2drop ] [ % make-english ] if ;
 
 : 0-99 ( n -- )
   dup 20 < [ units ] [ 10 /mod swap tenths "-" maybe-add ] if ;
 
 : 0-999 ( n -- )
   100 /mod swap
-  dup 0 = [ drop 0-99 ] [ units " hundred" % " and " maybe-add ] if ;
+  dup zero? [ drop 0-99 ] [ units " hundred" % " and " maybe-add ] if ;
 
 : make-english ( n -- )
   1000 /mod swap
-  dup 0 = [ drop 0-999 ] [ 0-999 " thousand" % " and " maybe-add ] if ;
+  dup zero? [ drop 0-999 ] [ 0-999 " thousand" % " and " maybe-add ] if ;
 
 PRIVATE>
 
@@ -57,9 +59,19 @@ PRIVATE>
   [ make-english ] "" make ;
 
 : euler017 ( -- answer )
-  1000 [ 1 + >english [ letter? ] subset length ] map sum ;
+  1000 [1,b] [ >english [ letter? ] subset length ] map sum ;
 
 ! [ euler017 ] 100 ave-time
 ! 9 ms run / 0 ms GC ave time - 100 trials
 
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+: euler017a ( -- answer )
+    1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ;
+
+! [ euler017a ] 100 ave-time
+! 14 ms run / 1 ms GC ave time - 100 trials
+
 MAIN: euler017

extra/project-euler/018/018.factor

@@ -1,6 +1,6 @@
-! Copyright (c) 2007 Samuel Tardieu.
+! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences ;
+USING: kernel math project-euler.common sequences ;
 IN: project-euler.018
 
 ! http://projecteuler.net/index.php?section=problems&id=18
@@ -8,39 +8,39 @@ IN: project-euler.018
 ! DESCRIPTION
 ! -----------
 
-! By starting at the top of the triangle below and moving to adjacent
+! By starting at the top of the triangle below and moving to adjacent numbers
-! numbers on the row below, the maximum total from top to bottom is
+! on the row below, the maximum total from top to bottom is 23.
-! 23.
 
-! 3
+!        3
-! 7 5
+!       7 5
-! 2 4 6
+!      2 4 6
-! 8 5 9 3
+!     8 5 9 3
 
 ! That is, 3 + 7 + 4 + 9 = 23.
 
 ! Find the maximum total from top to bottom of the triangle below:
 
-!                      75
+!                                 75
-!                     95 64
+!                               95  64
-!                   17 47 82
+!                             17  47  82
-!                  18 35 87 10
+!                           18  35  87  10
-!                20 04 82 47 65
+!                         20  04  82  47  65
-!               19 01 23 75 03 34
+!                       19  01  23  75  03  34
-!             88 02 77 73 07 63 67
+!                     88  02  77  73  07  63  67
-!            99 65 04 28 06 16 70 92
+!                   99  65  04  28  06  16  70  92
-!          41 41 26 56 83 40 80 70 33
+!                 41  41  26  56  83  40  80  70  33
-!         41 48 72 33 47 32 37 16 94 29
+!               41  48  72  33  47  32  37  16  94  29
-!       53 71 44 65 25 43 91 52 97 51 14
+!             53  71  44  65  25  43  91  52  97  51  14
-!      70 11 33 28 77 73 17 78 39 68 17 57
+!           70  11  33  28  77  73  17  78  39  68  17  57
-!    91 71 52 38 17 14 91 43 58 50 27 29 48
+!         91  71  52  38  17  14  91  43  58  50  27  29  48
-!   63 66 04 68 89 53 67 30 73 16 69 87 40 31
+!       63  66  04  68  89  53  67  30  73  16  69  87  40  31
-! 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
+!     04  62  98  27  23  09  70  98  73  93  38  53  60  04  23
+
+! NOTE: As there are only 16384 routes, it is possible to solve this problem by
+! trying every route. However, Problem 67, is the same challenge with a
+! triangle containing one-hundred rows; it cannot be solved by brute force, and
+! requires a clever method! ;o)
 
-! NOTE: As there are only 16384 routes, it is possible to solve this
-! problem by trying every route. However, Problem 67, is the same
-! challenge with a triangle containing one-hundred rows; it cannot be
-! solved by brute force, and requires a clever method! ;o)
 
 ! SOLUTION
 ! --------
@@ -51,40 +51,71 @@ IN: project-euler.018
 <PRIVATE
 
 : pyramid ( -- seq )
-  {
+    {
-                         75
+                             75
-                        95 64
+                            95 64
-                      17 47 82
+                          17 47 82
-                     18 35 87 10
+                         18 35 87 10
-                   20 04 82 47 65
+                       20 04 82 47 65
-                  19 01 23 75 03 34
+                      19 01 23 75 03 34
-                88 02 77 73 07 63 67
+                    88 02 77 73 07 63 67
-               99 65 04 28 06 16 70 92
+                   99 65 04 28 06 16 70 92
-             41 41 26 56 83 40 80 70 33
+                 41 41 26 56 83 40 80 70 33
-            41 48 72 33 47 32 37 16 94 29
+                41 48 72 33 47 32 37 16 94 29
-          53 71 44 65 25 43 91 52 97 51 14
+              53 71 44 65 25 43 91 52 97 51 14
-         70 11 33 28 77 73 17 78 39 68 17 57
+             70 11 33 28 77 73 17 78 39 68 17 57
-       91 71 52 38 17 14 91 43 58 50 27 29 48
+           91 71 52 38 17 14 91 43 58 50 27 29 48
-      63 66 04 68 89 53 67 30 73 16 69 87 40 31
+          63 66 04 68 89 53 67 30 73 16 69 87 40 31
-    04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
+        04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
-  }
+    }
-  15 [ 1+ cut swap ] map nip ;
+    15 [ 1+ cut swap ] map nip ;
 
 PRIVATE>
 
 ! Propagate one row into the upper one
 : propagate ( bottom top -- newtop )
-  [ over 1 tail rot first2 max rot + ] map nip ;
+    [ over 1 tail rot first2 max rot + ] map nip ;
 
 ! Not strictly needed, but it is nice to be able to dump the pyramid after
 ! the propagation
 : propagate-all ( pyramid -- newpyramid )
-  reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
+    reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
 
-: euler018 ( -- best )
+: euler018 ( -- answer )
-  pyramid propagate-all first first ;
+    pyramid propagate-all first first ;
 
 ! [ euler018 ] 100 ave-time
-! 0 ms run / 0 ms GC time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+<PRIVATE
+
+: source-018a ( -- triangle )
+    { { 75 }
+      { 95 64 }
+      { 17 47 82 }
+      { 18 35 87 10 }
+      { 20 04 82 47 65 }
+      { 19 01 23 75 03 34 }
+      { 88 02 77 73 07 63 67 }
+      { 99 65 04 28 06 16 70 92 }
+      { 41 41 26 56 83 40 80 70 33 }
+      { 41 48 72 33 47 32 37 16 94 29 }
+      { 53 71 44 65 25 43 91 52 97 51 14 }
+      { 70 11 33 28 77 73 17 78 39 68 17 57 }
+      { 91 71 52 38 17 14 91 43 58 50 27 29 48 }
+      { 63 66 04 68 89 53 67 30 73 16 69 87 40 31 }
+      { 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 } } ;
+
+PRIVATE>
+
+: euler018a ( -- answer )
+    source-018a max-path ;
+
+! [ euler018a ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
 
 MAIN: euler018

extra/project-euler/019/019.factor

@@ -1,6 +1,7 @@
-! Copyright (c) 2007 Samuel Tardieu.
+! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar combinators combinators.lib kernel math.ranges sequences ;
+USING: calendar combinators combinators.lib kernel math math.ranges namespaces
+    sequences ;
 IN: project-euler.019
 
 ! http://projecteuler.net/index.php?section=problems&id=19
@@ -12,17 +13,15 @@ IN: project-euler.019
 ! research for yourself.
 
 !     * 1 Jan 1900 was a Monday.
-!     * Thirty days has September,
+!     * Thirty days has September, April, June and November.  All the rest have
-!       April, June and November.
+!       thirty-one, Saving February alone, Which has twenty-eight, rain or
-!       All the rest have thirty-one,
+!       shine.  And on leap years, twenty-nine.
-!       Saving February alone,
+!     * A leap year occurs on any year evenly divisible by 4, but not on a
-!       Which has twenty-eight, rain or shine.
+!       century unless it is divisible by 400.
-!       And on leap years, twenty-nine.
+
-!     * A leap year occurs on any year evenly divisible by 4, but not
+! How many Sundays fell on the first of the month during the twentieth century
-!       on a century unless it is divisible by 400.
+! (1 Jan 1901 to 31 Dec 2000)?
 
-! How many Sundays fell on the first of the month during the twentieth
-! century (1 Jan 1901 to 31 Dec 2000)?
 
 ! SOLUTION
 ! --------
@@ -38,4 +37,34 @@ IN: project-euler.019
 ! [ euler019 ] 100 ave-time
 ! 1 ms run / 0 ms GC ave time - 100 trials
 
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+<PRIVATE
+
+: start-date ( -- timestamp )
+    1901 1 1 0 0 0 0 make-timestamp ;
+
+: end-date ( -- timestamp )
+    2000 12 31 0 0 0 0 make-timestamp ;
+
+: (first-days) ( end-date start-date -- )
+    2dup timestamp- 0 >= [
+        dup day-of-week , 1 +month (first-days)
+    ] [
+        2drop
+    ] if ;
+
+: first-days ( start-date end-date -- seq )
+    [ swap (first-days) ] { } make ;
+
+PRIVATE>
+
+: euler019a ( -- answer )
+    start-date end-date first-days [ zero? ] count ;
+
+! [ euler019a ] 100 ave-time
+! 131 ms run / 3 ms GC ave time - 100 trials
+
 MAIN: euler019

extra/project-euler/020/020.factor

@@ -0,0 +1,25 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math.combinatorics math.parser project-euler.common sequences ;
+IN: project-euler.020
+
+! http://projecteuler.net/index.php?section=problems&id=20
+
+! DESCRIPTION
+! -----------
+
+! n! means n * (n - 1) * ... * 3 * 2 * 1
+
+! Find the sum of the digits in the number 100!
+
+
+! SOLUTION
+! --------
+
+: euler020 ( -- answer )
+    100 factorial number>digits sum ;
+
+! [ euler020 ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler020

extra/project-euler/021/021.factor

@@ -0,0 +1,38 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.lib kernel math math.functions math.ranges namespaces
+    project-euler.common sequences ;
+IN: project-euler.021
+
+! http://projecteuler.net/index.php?section=problems&id=21
+
+! DESCRIPTION
+! -----------
+
+! Let d(n) be defined as the sum of proper divisors of n (numbers less than n
+! which divide evenly into n).
+
+! If d(a) = b and d(b) = a, where a != b, then a and b are an amicable pair and
+! each of a and b are called amicable numbers.
+
+! For example, the proper divisors of 220 are 1, 2, 4, 5, 10, 11, 20, 22, 44,
+! 55 and 110; therefore d(220) = 284. The proper divisors of 284 are 1, 2, 4,
+! 71 and 142; so d(284) = 220.
+
+! Evaluate the sum of all the amicable numbers under 10000.
+
+
+! SOLUTION
+! --------
+
+: amicable? ( n -- ? )
+    dup sum-proper-divisors
+    { [ 2dup = not ] [ 2dup sum-proper-divisors = ] } && 2nip ;
+
+: euler021 ( -- answer )
+    10000 [1,b] [ dup amicable? [ drop 0 ] unless ] sigma ;
+
+! [ euler021 ] 100 ave-time
+! 328 ms run / 10 ms GC ave time - 100 trials
+
+MAIN: euler021

extra/project-euler/022/022.factor

@@ -0,0 +1,60 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.lib io io.files kernel math math.parser namespaces sequences
+    sorting splitting strings system vocabs ;
+IN: project-euler.022
+
+! http://projecteuler.net/index.php?section=problems&id=22
+
+! DESCRIPTION
+! -----------
+
+! Using names.txt (right click and 'Save Link/Target As...'), a 46K text file
+! containing over five-thousand first names, begin by sorting it into
+! alphabetical order. Then working out the alphabetical value for each name,
+! multiply this value by its alphabetical position in the list to obtain a name
+! score.
+
+! For example, when the list is sorted into alphabetical order, COLIN, which is
+! worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So, COLIN
+! would obtain a score of 938 * 53 = 49714.
+
+! What is the total of all the name scores in the file?
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: (source-022) ( -- path )
+    [
+        "project-euler.022" vocab-root ?resource-path %
+        os "windows" = [
+            "\\project-euler\\022\\names.txt" %
+        ] [
+            "/project-euler/022/names.txt" %
+        ] if
+    ] "" make ;
+
+: source-022 ( -- seq )
+    (source-022) file-contents [ quotable? ] subset "," split ;
+
+: alpha-value ( str -- n )
+    string>digits [ 9 - ] sigma ;
+
+: name-scores ( seq -- seq )
+    dup length [ 1+ swap alpha-value * ] 2map ;
+
+PRIVATE>
+
+: euler022 ( -- answer )
+    source-022 natural-sort name-scores sum ;
+
+! [ euler022 ] 100 ave-time
+! 59 ms run / 1 ms GC ave time - 100 trials
+
+! source-022 [ natural-sort name-scores sum ] curry 100 ave-time
+! 45 ms run / 1 ms GC ave time - 100 trials
+
+MAIN: euler022

extra/project-euler/067/067.factor

@@ -1,6 +1,7 @@
-! Copyright (c) 2007 Samuel Tardieu.
+! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.files math.parser project-euler.018 sequences splitting ;
+USING: io io.files kernel math.parser namespaces project-euler.018
+    project-euler.common sequences splitting system vocabs ;
 IN: project-euler.067
 
 ! http://projecteuler.net/index.php?section=problems&id=67
@@ -8,19 +9,25 @@ IN: project-euler.067
 ! DESCRIPTION
 ! -----------
 
-! By starting at the top of the triangle below and moving to adjacent
+! By starting at the top of the triangle below and moving to adjacent numbers
-! numbers on the row below, the maximum total from top to bottom is
+! on the row below, the maximum total from top to bottom is 23.
-! 23.
 
-! 3
+!        3
-! 7 5
+!       7 5
-! 2 4 6
+!      2 4 6
-! 8 5 9 3
+!     8 5 9 3
 
 ! That is, 3 + 7 + 4 + 9 = 23.
 
-! Find the maximum total from top to bottom in triangle.txt, a 15K
+! Find the maximum total from top to bottom in triangle.txt (right click and
-! text file containing a triangle with one-hundred rows.
+! 'Save Link/Target As...'), a 15K text file containing a triangle with
+! one-hundred rows.
+
+! NOTE: This is a much more difficult version of Problem 18. It is not possible
+! to try every route to solve this problem, as there are 2^99 altogether! If you
+! could check one trillion (10^12) routes every second it would take over twenty
+! billion years to check them all. There is an efficient algorithm to solve it. ;o)
+
 
 ! SOLUTION
 ! --------
@@ -31,15 +38,45 @@ IN: project-euler.067
 <PRIVATE
 
 : pyramid ( -- seq )
-  "resource:extra/project-euler/067/triangle.txt" ?resource-path <file-reader>
+    "resource:extra/project-euler/067/triangle.txt" ?resource-path
-  lines [ " " split [ string>number ] map ] map ;
+    <file-reader> lines [ " " split [ string>number ] map ] map ;
 
 PRIVATE>
 
-: euler067 ( -- best )
+: euler067 ( -- answer )
-  pyramid propagate-all first first ;
+    pyramid propagate-all first first ;
 
 ! [ euler067 ] 100 ave-time
 ! 18 ms run / 0 ms GC time
 
-MAIN: euler067
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+<PRIVATE
+
+: (source-067a) ( -- path )
+    [
+        "project-euler.067" vocab-root ?resource-path %
+        os "windows" = [
+            "\\project-euler\\067\\triangle.txt" %
+        ] [
+            "/project-euler/067/triangle.txt" %
+        ] if
+    ] "" make ;
+
+: source-067a ( -- triangle )
+    (source-067a) <file-reader> lines [ " " split [ string>number ] map ] map ;
+
+PRIVATE>
+
+: euler067a ( -- answer )
+    source-067a max-path ;
+
+! [ euler067a ] 100 ave-time
+! 15 ms run / 0 ms GC ave time - 100 trials
+
+! source-067a [ max-path ] curry 100 ave-time
+! 3 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler067a

extra/project-euler/common/common.factor

@@ -1,9 +1,12 @@
 USING: arrays kernel hashtables math math.functions math.miller-rabin
-    math.ranges namespaces sequences combinators.lib ;
+    math.parser math.ranges namespaces sequences combinators.lib ;
 IN: project-euler.common
 
 ! A collection of words used by more than one Project Euler solution.
 
+: nth-pair ( n seq -- nth next )
+    over 1+ over nth >r nth r> ;
+
 <PRIVATE
 
 : count-shifts ( seq width -- n )
@@ -12,6 +15,9 @@ IN: project-euler.common
 : shift-3rd ( seq obj obj -- seq obj obj )
     rot 1 tail -rot ;
 
+: max-children ( seq -- seq )
+    [ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
+
 : >multiplicity ( seq -- seq )
     dup prune [
         [ 2dup [ = ] curry count 2array , ] each
@@ -20,23 +26,29 @@ IN: project-euler.common
 : reduce-2s ( n -- r s )
     dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
 
-: tau-limit ( n -- n )
-    sqrt floor >fixnum ;
-
 PRIVATE>
 
-
-: divisor? ( n m -- ? )
-    mod zero? ;
-
-: perfect-square? ( n -- ? )
-    dup sqrt mod zero? ;
-
 : collect-consecutive ( seq width -- seq )
     [
         2dup count-shifts [ 2dup head shift-3rd , ] times
     ] { } make 2nip ;
 
+: divisor? ( n m -- ? )
+    mod zero? ;
+
+: max-path ( triangle -- n )
+    dup length 1 > [
+        2 cut* first2 max-children [ + ] 2map add max-path
+    ] [
+        first first
+    ] if ;
+
+: number>digits ( n -- seq )
+    number>string string>digits ;
+
+: perfect-square? ( n -- ? )
+    dup sqrt divisor? ;
+
 : prime-factorization ( n -- seq )
     [
         2 [ over 1 > ]
@@ -50,12 +62,34 @@ PRIVATE>
 : prime-factors ( n -- seq )
     prime-factorization prune >array ;
 
+: (sum-divisors) ( n -- sum )
+    dup sqrt >fixnum [1,b] [
+        [ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
+        dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
+    ] { } make sum ;
+
+: sum-divisors ( n -- sum )
+    dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
+
+: sum-proper-divisors ( n -- sum )
+    dup sum-divisors swap - ;
+
+: abundant? ( n -- ? )
+    dup sum-proper-divisors < ;
+
+: deficient? ( n -- ? )
+    dup sum-proper-divisors > ;
+
+: perfect? ( n -- ? )
+    dup sum-proper-divisors = ;
+
 ! The divisor function, counts the number of divisors
 : tau ( n -- n )
     prime-factorization* flip second 1 [ 1+ * ] reduce ;
 
 ! Optimized brute-force, is often faster than prime factorization
 : tau* ( n -- n )
-    reduce-2s [ perfect-square? -1 0 ? ] keep dup tau-limit [1,b] [
+    reduce-2s [ perfect-square? -1 0 ? ] keep
+    dup sqrt >fixnum [1,b] [
         dupd divisor? [ >r 2 + r> ] when
     ] each drop * ;

extra/project-euler/project-euler.factor

@@ -1,14 +1,13 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: definitions io io.files kernel math.parser sequences strings
+USING: definitions io io.files kernel math.parser sequences vocabs
-    vocabs vocabs.loader
+    vocabs.loader project-euler.ave-time project-euler.common
     project-euler.001 project-euler.002 project-euler.003 project-euler.004
     project-euler.005 project-euler.006 project-euler.007 project-euler.008
     project-euler.009 project-euler.010 project-euler.011 project-euler.012
     project-euler.013 project-euler.014 project-euler.015 project-euler.016
-    project-euler.017 project-euler.018 project-euler.019
+    project-euler.017 project-euler.018 project-euler.019 project-euler.020
-    project-euler.067
+    project-euler.021 project-euler.022 project-euler.067 project-euler.134 ;
-    project-euler.134 ;
 IN: project-euler
 
 <PRIVATE
@@ -21,8 +20,8 @@ IN: project-euler
     number>string 3 CHAR: 0 pad-left ;
 
 : solution-path ( n -- str/f )
-    number>euler "project-euler." swap append vocab where
+    number>euler "project-euler." swap append
-    dup [ first ?resource-path ] when ;
+    vocab where dup [ first ?resource-path ] when ;
 
 PRIVATE>
 

extra/xmode/code2html/code2html.factor

@@ -1,6 +1,5 @@
-USING: xmode.tokens xmode.marker
+USING: xmode.tokens xmode.marker xmode.catalog kernel html html.elements io
-xmode.catalog kernel html html.elements io io.files
+    io.files sequences words ;
-sequences words ;
 IN: xmode.code2html
 
 : htmlize-tokens ( tokens -- )
@@ -21,7 +20,7 @@ IN: xmode.code2html
 : default-stylesheet ( -- )
     <style>
         "extra/xmode/code2html/stylesheet.css"
-        resource-path <file-reader> contents write
+        resource-path file-contents write
     </style> ;
 
 : htmlize-stream ( path stream -- )