--- 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))))