From f65ffc664093e7ecd74fb886293a5159bb26aeb5 Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Wed, 30 Sep 2009 23:08:45 +0900
Subject: [PATCH 1/4] faster implementation of euler023 using a hashtable

---
 extra/project-euler/023/023.factor | 13 +++++--------
 1 file changed, 5 insertions(+), 8 deletions(-)

diff --git a/extra/project-euler/023/023.factor b/extra/project-euler/023/023.factor
index 7c28ebfa6c..79aeccd8b4 100644
--- a/extra/project-euler/023/023.factor
+++ b/extra/project-euler/023/023.factor
@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.ranges project-euler.common sequences sets sorting ;
+USING: kernel math math.ranges project-euler.common sequences sets sorting assocs fry ;
 IN: project-euler.023
 
 ! http://projecteuler.net/index.php?section=problems&id=23
@@ -42,10 +42,9 @@ IN: project-euler.023
     [1,b] [ abundant? ] filter ;
 
 : possible-sums ( seq -- seq )
-    dup { } -rot [
-        dupd [ + ] curry map
-        rot append prune swap rest
-    ] each drop natural-sort ;
+    H{ } clone
+    [ dupd '[ _ [ + _ conjoin ] with each ] each ]
+    keep keys ;
 
 PRIVATE>
 
@@ -53,9 +52,7 @@ PRIVATE>
     source-023
     20161 abundants-upto possible-sums diff sum ;
 
-! TODO: solution is still too slow, although it takes under 1 minute
-
 ! [ euler023 ] time
-! 52780 ms run / 3839 ms GC
+! 2.15542 seconds
 
 SOLUTION: euler023

From bf054fe2b598fc400a4a4cab3a1be3a955a3bc49 Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Thu, 1 Oct 2009 00:05:47 +0900
Subject: [PATCH 2/4] Solution to euler255 (slow and not so pretty)

---
 extra/project-euler/255/255-tests.factor |  4 +
 extra/project-euler/255/255.factor       | 93 ++++++++++++++++++++++++
 extra/project-euler/255/authors.txt      |  1 +
 3 files changed, 98 insertions(+)
 create mode 100644 extra/project-euler/255/255-tests.factor
 create mode 100644 extra/project-euler/255/255.factor
 create mode 100644 extra/project-euler/255/authors.txt

diff --git a/extra/project-euler/255/255-tests.factor b/extra/project-euler/255/255-tests.factor
new file mode 100644
index 0000000000..b506144e3d
--- /dev/null
+++ b/extra/project-euler/255/255-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.255 tools.test ;
+IN: project-euler.255.tests
+
+[ 4.4474011180 ] [ euler255 ] unit-test
diff --git a/extra/project-euler/255/255.factor b/extra/project-euler/255/255.factor
new file mode 100644
index 0000000000..57a5c5fec7
--- /dev/null
+++ b/extra/project-euler/255/255.factor
@@ -0,0 +1,93 @@
+! Copyright (C) 2009 Jon Harper.
+! See http://factorcode.org/license.txt for BSD license.
+USING: project-euler.common math kernel sequences math.functions math.ranges prettyprint io threads math.parser locals arrays namespaces ;
+IN: project-euler.255
+
+! http://projecteuler.net/index.php?section=problems&id=255
+
+! DESCRIPTION
+! -----------
+! We define the rounded-square-root of a positive integer n as the square root of n rounded to the nearest integer.
+! 
+! The following procedure (essentially Heron's method adapted to integer arithmetic) finds the rounded-square-root of n:
+! 
+! Let d be the number of digits of the number n.
+! If d is odd, set x_(0) = 2×10^((d-1)⁄2).
+! If d is even, set x_(0) = 7×10^((d-2)⁄2).
+! Repeat:
+! 
+! until x_(k+1) = x_(k).
+! 
+! As an example, let us find the rounded-square-root of n = 4321.
+! n has 4 digits, so x_(0) = 7×10^((4-2)⁄2) = 70.
+! 
+! Since x_(2) = x_(1), we stop here.
+! So, after just two iterations, we have found that the rounded-square-root of 4321 is 66 (the actual square root is 65.7343137…).
+! 
+! The number of iterations required when using this method is surprisingly low.
+! For example, we can find the rounded-square-root of a 5-digit integer (10,000 ≤ n ≤ 99,999) with an average of 3.2102888889 iterations (the average value was rounded to 10 decimal places).
+! 
+! Using the procedure described above, what is the average number of iterations required to find the rounded-square-root of a 14-digit number (10^(13) ≤ n < 10^(14))?
+! Give your answer rounded to 10 decimal places.
+! 
+! Note: The symbols ⌊x⌋ and ⌈x⌉ represent the floor function and ceiling function respectively.
+! 
+<PRIVATE
+
+: round-to-10-decimals ( a -- b ) 1.0e10 * round 1.0e10 / ;
+
+! same as produce, but outputs the sum instead of the sequence of results
+: produce-sum ( id pred quot -- sum )
+    [ 0 ] 2dip [ [ dip swap ] curry ] [ [ dip + ] curry ] bi* while ; inline
+
+: x0 ( i -- x0 )
+    number-length dup even? 
+    [ 2 - 2 / 10 swap ^ 7 * ]
+    [ 1 - 2 / 10 swap ^ 2 * ] if ;
+: ⌈a/b⌉  ( a b -- ⌈a/b⌉ )
+    [ 1 - + ] keep /i ;
+
+: xk+1 ( n xk -- xk+1 )
+    [ ⌈a/b⌉ ] keep + 2 /i ;
+
+: next-multiple ( a multiple -- next )
+    [ [ 1 - ] dip /i 1 + ] keep * ;
+
+DEFER: iteration#
+! Gives the number of iterations when xk+1 has the same value for all a<=i<=n
+:: (iteration#) ( i xi a b -- # )
+    a xi xk+1 dup xi = 
+        [ drop i b a - 1 + * ] 
+        [ i 1 + swap a b iteration# ] if ;
+
+! Gives the number of iterations in the general case by breaking into intervals
+! in which xk+1 is the same.
+:: iteration# ( i xi a b -- # )
+    a 
+    a xi next-multiple 
+    [ dup b < ] 
+    [ 
+        ! set up the values for the next iteration
+        [ nip [ 1 + ] [ xi + ] bi ] 2keep
+        ! set up the arguments for (iteration#)
+        [ i xi ] 2dip (iteration#) 
+    ] produce-sum 
+    ! deal with the last numbers
+    [ drop b [ i xi ] 2dip (iteration#) ] dip
+    + ;
+
+: 10^ ( a -- 10^a ) 10 swap ^ ; inline
+
+: (euler255) ( a b -- answer ) 
+    [ 10^ ] bi@ 1 -
+    [ [ drop x0 1 swap ] 2keep iteration# ] 2keep
+    swap - 1 + /f ;
+
+
+PRIVATE>
+
+: euler255 ( -- answer ) 
+    13 14 (euler255) round-to-10-decimals ;
+
+SOLUTION: euler255
+
diff --git a/extra/project-euler/255/authors.txt b/extra/project-euler/255/authors.txt
new file mode 100644
index 0000000000..790786959d
--- /dev/null
+++ b/extra/project-euler/255/authors.txt
@@ -0,0 +1 @@
+Jon Harper
\ No newline at end of file

From a6a5245edb57fb9ee751c173fb25e4d9b8ba8541 Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Sun, 4 Oct 2009 03:18:04 +0900
Subject: [PATCH 3/4] more library usage and readability improvements

---
 extra/project-euler/051/051.factor | 52 ++++++++++++++++++++++--------
 1 file changed, 39 insertions(+), 13 deletions(-)

diff --git a/extra/project-euler/051/051.factor b/extra/project-euler/051/051.factor
index b42a491e3c..ff45e9e58a 100644
--- a/extra/project-euler/051/051.factor
+++ b/extra/project-euler/051/051.factor
@@ -1,38 +1,60 @@
 ! Copyright (C) 2009 Jon Harper.
 ! See http://factorcode.org/license.txt for BSD license.
+
+! http://projecteuler.net/index.php?section=problems&id=1
+
+! DESCRIPTION
+! -----------
+
+
+! By replacing the first digit of *3, it turns out that
+! six of the nine possible values:
+! 13, 23, 43, 53, 73, and 83, are all prime.
+! By replacing the third and fourth digits of 56**3 with the same digit,
+! this 5-digit number is the first example having seven primes among
+! the ten generated numbers, yielding the family:
+! 56003, 56113, 56333, 56443, 56663, 56773, and 56993.
+! Consequently 56003, being the first member of this family,
+! is the smallest prime with this property.
+! 
+! Find the smallest prime which, by replacing part of the number
+! (not necessarily adjacent digits) with the same digit,
+! is part of an eight prime value family.
+
+! SOLUTION
+! --------
+
+! for each prime number, count the families it belongs to. When one reaches count of 8, stop, and get the smallest number by replacing * with ones.
+
 USING: assocs kernel math math.combinatorics math.functions
 math.parser math.primes namespaces project-euler.common
-sequences sets strings grouping math.ranges arrays ;
+sequences sets strings grouping math.ranges arrays fry math.order ;
 IN: project-euler.051
-
+<PRIVATE
 SYMBOL: family-count
 SYMBOL: large-families
 : reset-globals ( -- ) 
     H{ } clone family-count set
     H{ } clone large-families set ;
 
-: append-or-create ( value seq/f -- seq )
-    dup [ swap suffix ] [ drop 1array ] if ;
-: append-at ( value key assoc -- )
-    [ at append-or-create ] 2keep set-at ;
-: digits-positions ( str -- positions )
-    H{ } clone swap over [ swapd append-at ] curry each-index ;
+: digits-positions ( str -- positions ) 
+    H{ } clone [ '[ swap _ push-at ] each-index ] keep ;
 
 : *-if-index ( char combination index -- char )
     member? [ drop CHAR: * ] when ;
 : replace-positions-with-* ( str positions -- str )
     [ *-if-index ] curry map-index ;
-: all-size-combinations ( seq -- combinations )
+: all-positions-combinations ( seq -- combinations )
     dup length [1,b] [ all-combinations ] with map concat ;
 
 : families ( stra -- seq )
     dup digits-positions values 
-    [ all-size-combinations [ replace-positions-with-* ] with map ] with map concat ;
+    [ all-positions-combinations [ replace-positions-with-* ] with map ] with map concat ;
 
 : save-family ( family -- )
-    family-count get dupd at 8 = [ large-families get conjoin ] [ drop ] if ;
+    dup family-count get at 8 = [ large-families get conjoin ] [ drop ] if ;
 : increment-family ( family -- )
-    family-count get dupd at* [ 1 + ] [ drop 1 ] if swap family-count get set-at ;
+   family-count get inc-at ;
 : handle-family ( family -- )
     [ increment-family ] [ save-family ] bi ;
 
@@ -52,7 +74,11 @@ SYMBOL: large-families
 : (euler051) ( i -- answer )
     dup test-n-digits-primes 
     dup assoc-size 0 > 
-    [ nip values [ fill-*-with-ones string>number ] map infimum ]
+    [ nip values [ fill-*-with-ones string>number ] [ min ] map-reduce ]
     [ drop 1 + (euler051) ] if ;
+PRIVATE>
+
 : euler051 ( -- answer )
     2 (euler051) ;
+
+SOLUTION: euler051

From 62ba9bc7de4e5fb8a0558edef7b5b0c9f42f1526 Mon Sep 17 00:00:00 2001
From: Jon Harper <jon.harper87@gmail.com>
Date: Wed, 7 Oct 2009 21:28:36 +0900
Subject: [PATCH 4/4] Euler 051 : added unit test, integration, author

---
 extra/project-euler/051/051-tests.factor |  4 ++++
 extra/project-euler/051/authors.txt      |  1 +
 extra/project-euler/project-euler.factor | 22 +++++++++++-----------
 3 files changed, 16 insertions(+), 11 deletions(-)
 create mode 100644 extra/project-euler/051/051-tests.factor
 create mode 100644 extra/project-euler/051/authors.txt

diff --git a/extra/project-euler/051/051-tests.factor b/extra/project-euler/051/051-tests.factor
new file mode 100644
index 0000000000..f6bd5bc37a
--- /dev/null
+++ b/extra/project-euler/051/051-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.051 tools.test ;
+IN: project-euler.051.tests
+
+[ 121313 ] [ euler051 ] unit-test
diff --git a/extra/project-euler/051/authors.txt b/extra/project-euler/051/authors.txt
new file mode 100644
index 0000000000..790786959d
--- /dev/null
+++ b/extra/project-euler/051/authors.txt
@@ -0,0 +1 @@
+Jon Harper
\ No newline at end of file
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index 1bba3182d1..3438de8c2d 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -14,17 +14,17 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     project-euler.037 project-euler.038 project-euler.039 project-euler.040
     project-euler.041 project-euler.042 project-euler.043 project-euler.044
     project-euler.045 project-euler.046 project-euler.047 project-euler.048
-    project-euler.049 project-euler.052 project-euler.053 project-euler.054
-    project-euler.055 project-euler.056 project-euler.057 project-euler.058
-    project-euler.059 project-euler.063 project-euler.067 project-euler.069
-    project-euler.071 project-euler.072 project-euler.073 project-euler.074
-    project-euler.075 project-euler.076 project-euler.079 project-euler.085
-    project-euler.092 project-euler.097 project-euler.099 project-euler.100
-    project-euler.102 project-euler.112 project-euler.116 project-euler.117
-    project-euler.124 project-euler.134 project-euler.148 project-euler.150
-    project-euler.151 project-euler.164 project-euler.169 project-euler.173
-    project-euler.175 project-euler.186 project-euler.190 project-euler.203
-    project-euler.215 ;
+    project-euler.049 project-euler.051 project-euler.052 project-euler.053 
+    project-euler.054 project-euler.055 project-euler.056 project-euler.057 
+    project-euler.058 project-euler.059 project-euler.063 project-euler.067 
+    project-euler.069 project-euler.071 project-euler.072 project-euler.073 
+    project-euler.074 project-euler.075 project-euler.076 project-euler.079
+    project-euler.085 project-euler.092 project-euler.097 project-euler.099 
+    project-euler.100 project-euler.102 project-euler.112 project-euler.116 
+    project-euler.117 project-euler.124 project-euler.134 project-euler.148
+    project-euler.150 project-euler.151 project-euler.164 project-euler.169 
+    project-euler.173 project-euler.175 project-euler.186 project-euler.190
+    project-euler.203 project-euler.215 ;
 IN: project-euler
 
 <PRIVATE