fork download
  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
stdin
Standard input is empty
stdout

Standard output is empty