fork download
copy 
  1. (def v8 [[8 6 7 3 2 5 1 4]
  2.         [6 8 3 7]
  3.         [7 3 8 6]
  4.         [3 7 6 8 1 4 5 2]
  5.               [1 8 5 2 4]
  6.               [8 1 2 4 5]])
  7.  
  8. (letfn [(dropTake [dn tn coll] (take tn (drop dn coll)))
  9.         (rotate90 [colls] (apply map list colls))
  10.         (cartesian-product
  11.           ; from clojure.contrib.combinatorics
  12.           [& seqs]
  13.           (let [v-original-seqs (vec seqs)
  14.             step
  15.             (fn step [v-seqs]
  16.               (let [increment
  17.                 (fn [v-seqs]
  18.                   (loop [i (dec (count v-seqs)), v-seqs v-seqs]
  19.                     (if (= i -1) nil
  20.                     (if-let [rst (next (v-seqs i))]
  21.                       (assoc v-seqs i rst)
  22.                       (recur (dec i) (assoc v-seqs i (v-original-seqs i)))))))]
  23.                 (when v-seqs
  24.                    (cons (map first v-seqs)
  25.                      (lazy-seq (step (increment v-seqs)))))))]
  26.             (when (every? first seqs)
  27.               (lazy-seq (step v-original-seqs)))))
  28.         (getLatinSquare [V x y o]
  29.           (let [fullRows (dropTake y o V)
  30.                 rows (map #(dropTake x o %) fullRows)
  31.                 cols (rotate90 rows)
  32.                 sortDistinct (fn [coll] (map #(sort (distinct %)) coll))
  33.                 nils (map #(every? identity %) rows)]
  34.             (if (every? identity nils)
  35.               (if (apply = (concat (map sort cols) (sortDistinct cols) (sortDistinct rows)))
  36.                 rows))))
  37.         (possibleArrangements [maxCount row]
  38.                (let [c (count row)
  39.                      d (- maxCount c)]
  40.                (for [lp (range (inc d)) :let [rp (- d lp)]]
  41.                  (concat (repeat lp nil) row (repeat rp nil)))))
  42.         (generateBoards [V]
  43.           (let [maxCount (apply max (map count V))
  44.                 arrs (map (partial possibleArrangements maxCount) V)]
  45.             (apply cartesian-product arrs)))
  46.         (findLatinSquares [Vs o]
  47.            (let [width (count (first (first Vs)))
  48.                 height (count (first Vs))]
  49.             (filter first
  50.               (for [x (range (inc (- width o)))
  51.                     y (range (inc (- height o)))
  52.                     V Vs]
  53.                 [(getLatinSquare V x y o) V x y o]))))
  54.         (countLatinSquares [Vs o]
  55.           (count (distinct (map first (findLatinSquares Vs o)))))
  56.         (countAllLatinSquares [Vs]
  57.           (let [width (count (first (first Vs)))
  58.                 height (count (first Vs))
  59.                 maxO (min width height)]
  60.             (apply hash-map
  61.               (flatten
  62.                 (for [o (range 2 (inc maxO)) :let [c (countLatinSquares Vs o)] :when (< 0 c)] [o c])))))
  63.         ]
  64.  
  65.   (defn lsq [V] (countAllLatinSquares (generateBoards V)))
  66. )
  67.  
  68. (lsq v8)
Success #stdin #stdout 1.88s 220224KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/L96buo
language:
Clojure (clojure 1.10.0)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!