My solution to https://4clojure.com/problem/127

ummels-4clojure-solution127.clj

;; ummels's solution to Love Triangle
;; https://4clojure.com/problem/127

(fn [mine]
  (let [n (count mine)
        ln #(loop [r 1 v %] (if (< v 2) r (recur (inc r) (quot v 2))))
        m (apply max (map ln mine))
        lmax (fn [xs] ; treats nil as -infinity
               (let [a (first xs) r1 (rest xs) b (first r1) r2 (rest r1)]
                 (cond (empty? r1) a
                       (nil? a) (recur r1)
                       (nil? b) (recur (cons a r2))
                       :else (recur (cons (max a b) r2)))))
        mineral? (fn [[x y]]
                   (and (>= (min x y) 0)
                        (< x n)
                        (loop [i y r (mine x)]
                          (if (zero? i) (odd? r) (recur (dec i) (quot r 2))))))
        area (fn [corner [x y] w]
               (let [sgn #(max (min % 1) -1)
                     lft [(sgn (+ x y)) (sgn (- y x))] ; [x y] turned ccw by 45
                     rt  [(sgn (- x y)) (sgn (+ x y))] ; [x y] turned cw by 45
                     points (for [k (range (inc w))
                                  i (range (inc k))
                                  b (if (and (some zero? [x y]) (< k w)) [0 1] [0])]
                              (map + corner
                                     (map * [i i] lft)
                                     (map * [(- k i) (- k i)] rt)
                                     (map * [b b] [x y])))]
                 (when (every? mineral? points) (count points))))]
    (lmax (for [x (range n)
                y (range m)
                :when (mineral? [x y])
                d [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]]
            (loop [r nil w 1]
              (if-let [a (area [x y] d w)]
                (recur a (inc w)) r))))))