Solution to Project Euler problem 44

extra/project-euler/044/044.factor

@@ -0,0 +1,50 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.functions math.ranges project-euler.common sequences ;
+IN: project-euler.044
+
+! http://projecteuler.net/index.php?section=problems&id=44
+
+! DESCRIPTION
+! -----------
+
+! Pentagonal numbers are generated by the formula, Pn=n(3n−1)/2. The first ten
+! pentagonal numbers are:
+
+!     1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ...
+
+! It can be seen that P4 + P7 = 22 + 70 = 92 = P8. However, their difference,
+! 70 − 22 = 48, is not pentagonal.
+
+! Find the pair of pentagonal numbers, Pj and Pk, for which their sum and
+! difference is pentagonal and D = |Pk − Pj| is minimised; what is the value of D?
+
+
+! SOLUTION
+! --------
+
+! Brute force using a cartesian product and an arbitrarily chosen limit.
+
+<PRIVATE
+
+: nth-pentagonal ( n -- seq )
+    dup 3 * 1- * 2 / ;
+
+: pentagonal? ( n -- ? )
+    dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
+
+: sum-and-diff? ( m n -- ? )
+    2dup + -rot - [ pentagonal? ] 2apply and ;
+
+PRIVATE>
+
+: euler044 ( -- answer )
+    2500 [1,b] [ nth-pentagonal ] map dup cartesian-product
+    [ first2 sum-and-diff? ] subset [ first2 - abs ] map infimum ;
+
+! [ euler044 ] 10 ave-time
+! 8924 ms run / 2872 ms GC ave time - 10 trials
+
+! TODO: this solution is ugly and not very efficient...find a better algorithm
+
+MAIN: euler044

extra/project-euler/project-euler.factor

@@ -12,9 +12,10 @@ 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.043 project-euler.048
-    project-euler.052 project-euler.067 project-euler.075 project-euler.097
-    project-euler.134 project-euler.169 project-euler.173 project-euler.175 ;
+    project-euler.041 project-euler.042 project-euler.043 project-euler.044
+    project-euler.048 project-euler.052 project-euler.067 project-euler.075
+    project-euler.097 project-euler.134 project-euler.169 project-euler.173
+    project-euler.175 ;
 IN: project-euler
 
 <PRIVATE