Problem 61 solution.

euler.clj

;;; Solution to https://projecteuler.net/problem=61

(defn quadratic-formula [a b c]
  (let [x (Math/sqrt (- (* b b) (* 4 a c)))]
    (set [(/ (+ (* -1 b) x) (* 2 a))
          (/ (- (* -1 b) x) (* 2 a))])))

(defn whole-number? [n]
  (when (and (number? n)
             (== (Math/round n) n))
    n))

(defn polygonal? [s n]
  (->> (quadratic-formula (/ (- s 2) 2) (/ (- 4 s) 2) (* -1 n))
       (filter pos?)
       first
       whole-number?))

(defn prob61 []
  (let [;; Polygons from triangles through octagons.
        poly-range-set
        (set (range 3 9))

        ;; Map of candidate numbers to a set of the polygon types each
        ;; candidate satisfies. Each entry has a non-empty set,
        ;; meaning there are no numbers that aren't some sort of
        ;; polygonal of interest.
        polygonals
        (->> (range 1000 10000)
             (map (fn [n] [n (->> poly-range-set
                                  (filter #(polygonal? % n))
                                  set)]))
             (filter (comp not empty? #(nth % 1)))
             (into {}))

        ;; Set of all two digit prefixes of polygonal numbers of
        ;; interest.
        prefixes
        (->> (keys polygonals) (map #(quot % 100)) set)

        ;; Set of all two digit suffixes of polygonal numbers of
        ;; interest.
        suffixes
        (->> (keys polygonals) (map #(mod % 100)) set)

        ;; Given the nature of a number chain, each prefix also needs
        ;; to be a suffix, so both the prefix and the suffix of any
        ;; number we're looking for must be in this union of the sets
        ;; of prefixes and suffixes.
        candidate-pairs
        (set/intersection prefixes suffixes)

        ;; Set of polygonal numbers that are made of a prefix and a
        ;; suffix that are in the above candidate-pairs set.
        candidates
        (->> (keys polygonals)
             (filter #(and (candidate-pairs (quot % 100))
                           (candidate-pairs (mod % 100))))
             set)

        ;; Filtered inversion of polygonals map keyed by polygon type
        ;; with a value containing a set of all polygonal numbers of
        ;; that type that satisfy the above candidate test.
        poly-map
        (reduce (fn [polys [n ps]]
                  (reduce
                   (fn [polys s]
                     (update polys s (fnil conj #{}) n))
                   polys
                   ps))
                {}
                (map #(vector % (polygonals %)) candidates))]

    (letfn [(is-chain? ([a b]
                        (== (quot b 100) (mod a 100)))
                       ([a b c]
                        (and (is-chain? a b)
                             (== (mod b 100) (quot c 100)))))

            (reduced-if [x] (if x (reduced x) nil))

            ;; Find a chain `cs` that exhausts the given set of
            ;; polygons `ss`. Returns nil if no chain is found.
            (chain [cs ss]
              ;; If there is a single polygon type remaining, a chain
              ;; must loop around to the first element in the chain.
              (if (== (count ss) 1)
                (when-let [c (->> (first ss)
                                  poly-map
                                  (filter #(is-chain? (last cs) % (first cs)))
                                  first)]
                  (conj cs c))
                ;; If there are multiple polygon types remaining, find
                ;; each matching candidate among all of the remaining
                ;; polygon types, and attempt to build a chain with
                ;; each, passing the given set of polygon types minus
                ;; the polygon type of the candidate under
                ;; consideration.
                (loop [[s & next-ss] ss]
                  (if s
                    (or (reduce
                         (fn [acc c]
                           (when (is-chain? (last cs) c)
                             (reduced-if (chain (conj cs c) (disj ss s)))))
                         nil
                         (poly-map s))
                        (recur (set next-ss)))))))]

      ;; For each candidate in the highest-sided polygon under
      ;; consideration (an arbitrary choice), provide the candidate as
      ;; a seed and attempt to find a chain. Return the sum of the
      ;; elements of the first chain that is found.
      (->>
       (reduce (fn [acc c] (reduced-if (chain [c] (disj poly-range-set 8))))
               nil
               (poly-map (apply max poly-range-set)))
       (apply +)))))