ummels-4clojure-solution138.clj

;; ummels's solution to Squares Squared
;; https://4clojure.com/problem/138

(fn [start end]
  (letfn
    [(squares [start end]
       (take-while #(<= % end) (iterate #(* % %) start)))
     (arrange [x]
       (let [n (count x)
             dim (int (Math/ceil (Math/sqrt n)))
             y (concat x (repeat (- (* dim dim) n) \*))
             rot (fn [[i j]]
                   (cond (= j 0) [j i]
                         (= i 0) [(* j -1) i]))
             legal? (fn [[i j]] (and (>= i 0) (>= j 0) (< i dim) (< j dim)))]
         (loop [p (if (odd? dim) [0 (dec dim)] [(dec dim) 0])
                d (if (odd? dim) [0 -1] [0 1])
                in (reverse y)
                res (vec (repeat dim (vec (repeat dim nil))))]
           (cond
             (empty? in) res
             (and (legal? (map + p d)) (nil? (get-in res (map + p d))))
               (recur (map + p d) d (rest in) (assoc-in res p (first in)))
             :else
               (recur (map + p (rot d)) (rot d) (rest in) (assoc-in res p (first in)))))))
     (rotate [x]
       (let [n (count x)
             m (- (* 2 n) 1)]
         (loop [i 0
                j 0
                res (vec (repeat m (vec (repeat n nil))))]
           (cond
             (and (< i n) (< j n))
               (recur i (inc j) (assoc-in res [(+ i j) j] (get-in x [i j])))
             (< i n) (recur (inc i) 0 res)
             :else res))))
     (pretty [x]
       (let [n (count (first x))]
         (for [r x]
           (let [s (take-while (complement nil?) (drop-while nil? r))
                 m (- n (count s))]
             (apply str
               (concat (repeat m \space)
                       (rest (interleave (repeat \space) s))
                       (repeat m \space)))))))]
    (pretty (rotate (arrange (mapcat str (squares start end)))))))