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.