(def v8 [[8 6 7 3 2 5 1 4]
[6 8 3 7]
[7 3 8 6]
[3 7 6 8 1 4 5 2]
[1 8 5 2 4]
[8 1 2 4 5]])
(letfn [(dropTake [dn tn coll] (take tn (drop dn coll)))
(rotate90 [colls] (apply map list colls))
(cartesian-product
; from clojure.contrib.combinatorics
[& seqs]
(let [v-original-seqs (vec seqs)
step
(fn step [v-seqs]
(let [increment
(fn [v-seqs]
(loop [i (dec (count v-seqs)), v-seqs v-seqs]
(if (= i -1) nil
(if-let [rst (next (v-seqs i))]
(assoc v-seqs i rst)
(recur (dec i) (assoc v-seqs i (v-original-seqs i)))))))]
(when v-seqs
(cons (map first v-seqs)
(lazy-seq (step (increment v-seqs)))))))]
(when (every? first seqs)
(lazy-seq (step v-original-seqs)))))
(getLatinSquare [V x y o]
(let [fullRows (dropTake y o V)
rows (map #(dropTake x o %) fullRows)
cols (rotate90 rows)
sortDistinct (fn [coll] (map #(sort (distinct %)) coll))
nils (map #(every? identity %) rows)]
(if (every? identity nils)
(if (apply = (concat (map sort cols) (sortDistinct cols) (sortDistinct rows)))
rows))))
(possibleArrangements [maxCount row]
(let [c (count row)
d (- maxCount c)]
(for [lp (range (inc d)) :let [rp (- d lp)]]
(concat (repeat lp nil) row (repeat rp nil)))))
(generateBoards [V]
(let [maxCount (apply max (map count V))
arrs (map (partial possibleArrangements maxCount) V)]
(apply cartesian-product arrs)))
(findLatinSquares [Vs o]
(let [width (count (first (first Vs)))
height (count (first Vs))]
(filter first
(for [x (range (inc (- width o)))
y (range (inc (- height o)))
V Vs]
[(getLatinSquare V x y o) V x y o]))))
(countLatinSquares [Vs o]
(count (distinct (map first (findLatinSquares Vs o)))))
(countAllLatinSquares [Vs]
(let [width (count (first (first Vs)))
height (count (first Vs))
maxO (min width height)]
(apply hash-map
(flatten
(for [o (range 2 (inc maxO)) :let [c (countLatinSquares Vs o)] :when (< 0 c)] [o c])))))
]
(defn lsq [V] (countAllLatinSquares (generateBoards V)))
)
(lsq v8)