https://4clojure.com/problem/82 の答なんだけど、大変だったから解き方のメモ

word_chain.clj

;; condotti's solution to Word Chains
;; https://4clojure.com/problem/82

; この問題は結局グラフに開いたハミルトン路が含まれるかに帰着します。
; 単語の順列を生成してしらみ潰しに調べればわかるのですが、効率が悪すぎるので、
; 単語を頂点、1文字違いの単語の組を辺と考えて、辺の組み合わせを生成します。
; 全ての辺を使ったグラフと頂点の数を変えずに、開いたオイラー路(一筆書き)が
; できれば、元のグラフにはハミルトン路が含まれることになります。元のグラフ
; から余計な辺を取り除くイメージですね。一筆書きは頂点の次数を求めれば判定
; できます。多分しらみ潰しに調べるよりも多少は効率がいいはず。
; ところで一番大変だったのは2つの単語が1文字違いかどうかの判定だったりします。

(fn [wd]
  (letfn [(differ1? [w1 w2 & d]
            (if (empty? w1) (= (count w2) 1)
                (if (empty? w2) (= (count w1) 1)
                    (if (= (* (count w1) (count w2)) 1) true
                        (if (nil? d)
                          (if (= (first w1) (first w2)) (recur (rest w1) (rest w2) nil)
                              (recur w1 w2 true))
                          (if (= (last w1) (last w2)) (recur (butlast w1) (butlast w2) true)
                              false))))))
          (comb [xs]
            (if (empty? xs) [[]]
                (let [l (comb (rest xs))]
                  (concat (map #(conj % (first xs)) l) l))))
          (deg [xs] (vals (frequencies (flatten xs))))]
    (let [xs (into [] wd)
          d1 (filter #(differ1? (first %) (second %))
                     (for [x (range (dec (count xs))) y (range (inc x) (count xs))] [(xs x) (xs y)]))]
      ((fn [xs]
         (if (empty? xs) false
             (if (and (= (count (first xs)) (count wd))
                      (= (count (filter odd? (deg (first xs)))) 2))
               true
               (recur (rest xs)))))
       (comb d1)))))