# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1488585536 0
# Node ID 0d4df5913ec83d16b7e92bb1437592d16ad929b3
# Parent  b1656a023096094ac80dd15d6b8825563d11eb9e
Problem 61

diff -r b1656a023096 -r 0d4df5913ec8 src/euler.lisp
--- a/src/euler.lisp	Fri Mar 03 12:56:41 2017 +0000
+++ b/src/euler.lisp	Fri Mar 03 23:58:56 2017 +0000
@@ -338,6 +338,13 @@
   (dividesp (+ 1 (sqrt (1+ (* 8.0d0 n)))) 4))
 
 
+(defun heptagon (n)
+  (* n (- (* 5 n) 3) 1/2))
+
+(defun octagon (n)
+  (* n (- (* 3 n) 2)))
+
+
 (defun parse-strings-file (filename)
   (-<> filename
     read-file-into-string
@@ -1863,6 +1870,86 @@
                       (when (satisfiesp e (list a b c d))
                         (in main (return-from problem-60 (+ a b c d e)))))))))))))))
 
+(defun problem-61 ()
+  ;; Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers
+  ;; are all figurate (polygonal) numbers and are generated by the following
+  ;; formulae:
+  ;;
+  ;; Triangle	 	P3,n=n(n+1)/2	 	1, 3, 6, 10, 15, ...
+  ;; Square	 	P4,n=n²		  	1, 4, 9, 16, 25, ...
+  ;; Pentagonal	 	P5,n=n(3n−1)/2	 	1, 5, 12, 22, 35, ...
+  ;; Hexagonal	 	P6,n=n(2n−1)	 	1, 6, 15, 28, 45, ...
+  ;; Heptagonal	 	P7,n=n(5n−3)/2	 	1, 7, 18, 34, 55, ...
+  ;; Octagonal	 	P8,n=n(3n−2)	 	1, 8, 21, 40, 65, ...
+  ;;
+  ;; The ordered set of three 4-digit numbers: 8128, 2882, 8281, has three
+  ;; interesting properties.
+  ;;
+  ;; 1. The set is cyclic, in that the last two digits of each number is the
+  ;;    first two digits of the next number (including the last number with the
+  ;;    first).
+  ;; 2. Each polygonal type: triangle (P3,127=8128), square (P4,91=8281), and
+  ;;    pentagonal (P5,44=2882), is represented by a different number in the
+  ;;    set.
+  ;; 3. This is the only set of 4-digit numbers with this property.
+  ;;
+  ;; Find the sum of the only ordered set of six cyclic 4-digit numbers for
+  ;; which each polygonal type: triangle, square, pentagonal, hexagonal,
+  ;; heptagonal, and octagonal, is represented by a different number in the set.
+  (labels ((numbers (generator)
+             (iterate (for i :from 1)
+                      (for n = (funcall generator i))
+                      (while (<= n 9999))
+                      (when (>= n 1000)
+                        (collect n))))
+           (split (number)
+             (truncate number 100))
+           (prefix (number)
+             (when number
+               (nth-value 0 (split number))))
+           (suffix (number)
+             (when number
+               (nth-value 1 (split number))))
+           (matches (prefix suffix number)
+             (multiple-value-bind (p s)
+                 (split number)
+               (and (or (not prefix)
+                        (= prefix p))
+                    (or (not suffix)
+                        (= suffix s)))))
+           (choose (numbers used prefix &optional suffix)
+             (-<> numbers
+               (remove-if-not (curry #'matches prefix suffix) <>)
+               (set-difference <> used)))
+           (search-sets (sets)
+             (recursively ((sets sets)
+                           (path nil))
+               (destructuring-bind (set . remaining) sets
+                 (if remaining
+                   ;; We're somewhere in the middle, recur on any number whose
+                   ;; prefix matches the suffix of the previous element.
+                   (iterate
+                     (for number :in (choose set path (suffix (car path))))
+                     (recur remaining (cons number path)))
+                   ;; We're on the last set, we need to find a number that fits
+                   ;; between the penultimate element and first element to
+                   ;; complete the cycle.
+                   (when-let*
+                       ((init (first (last path)))
+                        (prev (car path))
+                        (final (choose set path (suffix prev) (prefix init))))
+                     (return-from problem-61
+                       (sum (reverse (cons (first final) path))))))))))
+    (map-permutations #'search-sets
+                      (list (numbers #'triangle)
+                            (numbers #'square)
+                            (numbers #'pentagon)
+                            (numbers #'hexagon)
+                            (numbers #'heptagon)
+                            (numbers #'octagon)))))
+
+
+
 
 (defun problem-74 ()
   ;; The number 145 is well known for the property that the sum of the factorial
@@ -1993,6 +2080,8 @@
 (test p58 (is (= 26241 (problem-58))))
 (test p59 (is (= 107359 (problem-59))))
 (test p60 (is (= 26033 (problem-60))))
+(test p61 (is (= 28684 (problem-61))))
+
 
 (test p74 (is (= 402 (problem-74))))
 (test p145 (is (= 608720 (problem-145))))