Solution to Project Euler problem 45

extra/project-euler/044/044.factor

@@ -30,9 +30,6 @@ IN: project-euler.044
 : 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 ;
 

extra/project-euler/045/045.factor

@@ -0,0 +1,49 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math project-euler.common ;
+IN: project-euler.045
+
+! http://projecteuler.net/index.php?section=problems&id=45
+
+! DESCRIPTION
+! -----------
+
+! Triangle, pentagonal, and hexagonal numbers are generated by the following
+! formulae:
+!     Triangle     Tn = n(n + 1) / 2    1, 3,  6, 10, 15, ...
+!     Pentagonal   Pn = n(3n − 1) / 2   1, 5, 12, 22, 35, ...
+!     Hexagonal    Hn = n(2n − 1)       1, 6, 15, 28, 45, ...
+
+! It can be verified that T285 = P165 = H143 = 40755.
+
+! Find the next triangle number that is also pentagonal and hexagonal.
+
+
+! SOLUTION
+! --------
+
+! All hexagonal numbers are also triangle numbers, so iterate through hexagonal
+! numbers until you find one that is pentagonal as well.
+
+<PRIVATE
+
+: nth-hexagonal ( n -- m )
+    dup 2 * 1- * ;
+
+DEFER: next-solution
+
+: (next-solution) ( n hexagonal -- n )
+    dup pentagonal? [ nip ] [ drop next-solution ] if ;
+
+: next-solution ( n -- m )
+    1+ dup nth-hexagonal (next-solution) ;
+
+PRIVATE>
+
+: euler045 ( -- answer )
+    143 next-solution ;
+
+! [ euler045 ] 100 ave-time
+! 18 ms run / 1 ms GC ave time - 100 trials
+
+MAIN: euler045

extra/project-euler/common/common.factor

@@ -16,6 +16,7 @@ IN: project-euler.common
 ! nth-triangle - #12, #42
 ! number>digits - #16, #20, #30, #34
 ! pandigital? - #32, #38
+! pentagonal? - #44, #45
 ! propagate-all - #18, #67
 ! sum-proper-divisors - #21
 ! tau* - #12
@@ -84,6 +85,9 @@ PRIVATE>
 : pandigital? ( n -- ? )
     number>string natural-sort "123456789" = ;
 
+: pentagonal? ( n -- ? )
+    dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
+
 ! Not strictly needed, but it is nice to be able to dump the triangle after the
 ! propagation
 : propagate-all ( triangle -- newtriangle )

extra/project-euler/project-euler.factor

@@ -13,9 +13,9 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
     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.044
-    project-euler.048 project-euler.052 project-euler.053 project-euler.067
-    project-euler.075 project-euler.079 project-euler.097 project-euler.134
-    project-euler.169 project-euler.173 project-euler.175 ;
+    project-euler.045 project-euler.048 project-euler.052 project-euler.053
+    project-euler.067 project-euler.075 project-euler.079 project-euler.097
+    project-euler.134 project-euler.169 project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE