language: Clojure (clojure 1.5.0-RC2)
date: 195 days 4 hours ago
link:
visibility: public 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

(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)