Solution to Project Euler problem 74

extra/project-euler/074/074-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.074 tools.test ;
+IN: project-euler.074.tests
+
+[ 402 ] [ euler074 ] unit-test

extra/project-euler/074/074.factor

@@ -0,0 +1,67 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs hashtables kernel math math.ranges
+project-euler.common sequences ;
+IN: project-euler.074
+
+! http://projecteuler.net/index.php?section=problems&id=074
+
+! DESCRIPTION
+! -----------
+
+! The number 145 is well known for the property that the sum of the factorial
+! of its digits is equal to 145:
+
+! 1! + 4! + 5! = 1 + 24 + 120 = 145
+
+! Perhaps less well known is 169, in that it produces the longest chain of
+! numbers that link back to 169; it turns out that there are only three such
+! loops that exist:
+
+! 169 → 363601 → 1454 → 169
+! 871 → 45361 → 871
+! 872 → 45362 → 872
+
+! It is not difficult to prove that EVERY starting number will eventually get
+! stuck in a loop. For example,
+
+! 69 → 363600 → 1454 → 169 → 363601 (→ 1454)
+! 78 → 45360 → 871 → 45361 (→ 871)
+! 540 → 145 (→ 145)
+
+! Starting with 69 produces a chain of five non-repeating terms, but the
+! longest non-repeating chain with a starting number below one million is sixty
+! terms.
+
+! How many chains, with a starting number below one million, contain exactly
+! sixty non-repeating terms?
+
+
+! SOLUTION
+! --------
+
+! Brute force
+
+<PRIVATE
+
+: digit-factorial ( n -- n! )
+    { 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
+
+: digits-factorial-sum ( n -- n )
+    number>digits [ digit-factorial ] sigma ;
+
+: chain-length ( n -- n )
+    61 <hashtable> [ 2dup at* nip f = ] [
+        2dup dupd set-at [ digits-factorial-sum ] dip
+    ] while nip assoc-size ;
+
+PRIVATE>
+
+: euler074 ( -- answer )
+    1000000 [1,b] [ chain-length 60 = ] count ;
+
+! [ euler074 ] 10 ave-time
+! 25134 ms ave run time - 31.96 SD (10 trials)
+
+SOLUTION: euler074
+

extra/project-euler/project-euler.factor

@@ -17,13 +17,14 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     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.075
+    project-euler.071 project-euler.072 project-euler.073 project-euler.074
-    project-euler.076 project-euler.079 project-euler.085 project-euler.092
+    project-euler.075 project-euler.076 project-euler.079 project-euler.085
-    project-euler.097 project-euler.099 project-euler.100 project-euler.102
+    project-euler.092 project-euler.097 project-euler.099 project-euler.100
-    project-euler.112 project-euler.116 project-euler.117 project-euler.124
+    project-euler.102 project-euler.112 project-euler.116 project-euler.117
-    project-euler.134 project-euler.148 project-euler.150 project-euler.151
+    project-euler.124 project-euler.134 project-euler.148 project-euler.150
-    project-euler.164 project-euler.169 project-euler.173 project-euler.175
+    project-euler.151 project-euler.164 project-euler.169 project-euler.173
-    project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
+    project-euler.175 project-euler.186 project-euler.190 project-euler.203
+    project-euler.215 ;
 IN: project-euler
 
 <PRIVATE