Solution to Project Euler problem 52

extra/project-euler/052/052.factor

@@ -0,0 +1,50 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.lib kernel math project-euler.common sequences sorting ;
+IN: project-euler.052
+
+! http://projecteuler.net/index.php?section=problems&id=52
+
+! DESCRIPTION
+! -----------
+
+! It can be seen that the number, 125874, and its double, 251748, contain
+! exactly the same digits, but in a different order.
+
+! Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x,
+! contain the same digits.
+
+
+! SOLUTION
+! --------
+
+! Analysis shows the number must be odd, divisible by 3, and larger than 123456
+
+<PRIVATE
+
+: map-nx ( n x -- seq )
+    [ 1+ * ] with map ; inline
+
+: all-same-digits? ( seq -- ? )
+    [ number>digits natural-sort ] map all-equal? ;
+
+: candidate? ( n -- ? )
+    { [ dup odd? ] [ dup 3 mod zero? ] } && nip ;
+
+: next-all-same ( x n -- n )
+    dup candidate? [
+        2dup swap map-nx all-same-digits?
+        [ nip ] [ 1+ next-all-same ] if
+    ] [
+        1+ next-all-same
+    ] if ;
+
+PRIVATE>
+
+: euler052 ( -- answer )
+    6 123456 next-all-same ;
+
+! [ euler052 ] 100 ave-time
+! 403 ms run / 7 ms GC ave time - 100 trials
+
+MAIN: euler052

extra/project-euler/project-euler.factor

@@ -12,9 +12,9 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
     project-euler.029 project-euler.030 project-euler.031 project-euler.032
     project-euler.033 project-euler.034 project-euler.035 project-euler.036
     project-euler.037 project-euler.038 project-euler.039 project-euler.040
-    project-euler.041 project-euler.042 project-euler.048 project-euler.067
+    project-euler.041 project-euler.042 project-euler.048 project-euler.052
-    project-euler.075 project-euler.134 project-euler.169 project-euler.173
+    project-euler.067 project-euler.075 project-euler.134 project-euler.169
-    project-euler.175 ;
+    project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE