Project Euler Problem 61

Problem 61 is yet another digit manipulation problem. This time, we have to find a set of six numbers that overlap in a cyclic fashion, and each number must be from a different one of six sets (triangular through octagonal number sets). The numbers are all 4 digits long and two digits overlap cyclically at each step.

The idiom I came up with to solve this problem reminded me strongly of the way I solved problem 60: build up a list of solutions that are stored in the tree-like computation created by the for loop, and then pull out the first valid answer.

(def triangle-nums   (map #(/ (* % (+ % 1)) 2) (iterate inc 1)))
(def square-nums     (map #(* % %) (iterate inc 1)))
(def pentagonal-nums (map #(/ (* % (- (* 3 %) 1)) 2) (iterate inc 1)))
(def hexagonal-nums  (map #(* % (- (* 2 %) 1)) (iterate inc 1)))
(def heptagonal-nums (map #(/ (* % (- (* 5 %) 3)) 2)  (iterate inc 1)))
(def octagonal-nums  (map #(* % (- (* 3 %) 2)) (iterate inc 1)))

(defn conj-to-cycle
"Conjugates an element to the front or back of a list of elements such that
the list is cyclic (overlap 2). Returns nil if n cannot be added validly. "
[coll n]
(cond
(= (subs (str (first coll)) 0 2) (subs (str n) 2 4)) (concat [n] coll)
(= (subs (str (last coll)) 2 4) (subs (str n) 0 2)) (concat coll [n])
:else nil))

(defn cyclic?
"Returns true iff the collection's last element's last two digits are the same
as the first element's first two digits. "
[coll]
(= (subs (str (first coll)) 0 2)
(subs (str (last coll)) 2 4)))

(defn take-between [bot top coll]
(take-while #(< % top) (drop-while #(< % bot) coll)))

(defn conj-valid-nums
"Attempts to conjugate all valid 4 digit numbers in the lazy seq nums into
the cyclic collections held in coll."
[coll nums]
(remove nil? (map #(conj-to-cycle coll %) (take-between 1000 10000 nums))))

(defn euler-61 []
(first
(for [a (map vector (take-between 1000 10000 triangle-nums))
b (conj-valid-nums a square-nums)
c (conj-valid-nums b pentagonal-nums)
d (conj-valid-nums c hexagonal-nums)
e (conj-valid-nums d heptagonal-nums)
f (conj-valid-nums e octagonal-nums)
:when (cyclic? f)]
(reduce + f))))

(time (euler-61)) ;; "Elapsed time: 132.424044 msecs"


This code seems reasonably compact and performance is good, yet I still look euler-61 and wonder if there is a better way to represent the idiom present in that for loop; perhaps some fancy threading function like -> that would capture this abstraction better and remove the need for the a b c d e f’s.

Then again, the simplicity of the above is attractive and probably valuable. Further compaction of this algorithm would probably affect readability, so I’ll just leave it here.

See ya later.