# 0d4df5913ec8

Problem 61

author | Steve Losh <steve@stevelosh.com> |
---|---|

date | Fri, 03 Mar 2017 23:58:56 +0000 |

parents | b1656a023096 |

children | a31a782a35b0 |

branches/tags | (none) |

files | src/euler.lisp |

## Changes

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