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. (defn mapv
  9.   "Returns a vector consisting of the result of applying f to the
  10.   set of first items of each coll, followed by applying f to the set
  11.   of second items in each coll, until any one of the colls is
  12.   exhausted.  Any remaining items in other colls are ignored. Function
  13.   f should accept number-of-colls arguments."
  14.   {:added "1.4"
  15.    :static true}
  16.   ([f coll]
  17.      (-> (reduce (fn [v o] (conj! v (f o))) (transient []) coll)
  18.          persistent!))
  19.   ([f c1 c2]
  20.      (into [] (map f c1 c2)))
  21.   ([f c1 c2 c3]
  22.      (into [] (map f c1 c2 c3)))
  23.   ([f c1 c2 c3 & colls]
  24.      (into [] (apply map f c1 c2 c3 colls))))
  25.  
  26. (def lsq (fn [x](letfn [
  27. (max-row-len [x]
  28.   (reduce max (map count x)))
  29.  
  30. (min-row-len [x]
  31.   (reduce min (map count x)))
  32.  
  33. (fill-x  [x]
  34.   (loop [y []
  35.          row 0]
  36.     (cond (= row (count x)) y
  37.           :else (recur
  38.                  (cond (< (count (nth x row)) (max-row-len x))
  39.                        (conj y
  40.                              (vec
  41.                               (concat (nth x row)
  42.                                       (take (- (max-row-len x)
  43.                                                (count (nth x row))) (repeat :nil)))))
  44.                        :else (conj y (nth x row)))
  45.                  (inc row)))))
  46.  
  47.  
  48. (vec-contains-:nil? [v]
  49.   (cond (= () (filter #(= :nil %) v)) false :else true))
  50.  
  51. (contains-:nil?  [x]
  52.   (cond (= (some #{:nil} (flatten x)) :nil) true :else false))
  53.  
  54. (only-:nil? [x]
  55.   (= (count (filter (fn [y] (= :nil y)) (flatten x))) (count (flatten x))))
  56.  
  57. (any-:nil? [x]
  58.   (= (count (filter (fn [y] (= :nil y)) (flatten x))) 0))
  59.  
  60.  
  61. (shift-row  [row]
  62.    (cond (or (only-:nil? row) (not= (last row) :nil)) nil
  63.         :else (vec (concat [:nil] (butlast row)))))
  64.  
  65. (append-variants  [x v]
  66.    (cond (or (any-:nil? v) (only-:nil? v)) (conj [] (vec (conj x v)))
  67.         :else (loop [y []
  68.                      w v]
  69.                 (cond (nil? w) y
  70.                       :else (recur (conj y (vec (conj x w))) (shift-row w))))))
  71.  
  72.  
  73. (build-search-base  [x]
  74.    (cond (any-:nil? x) (vector x)
  75.         :else (loop [y (append-variants nil (nth x 0))
  76.                      row-x 1]
  77.                 (cond (= row-x (count x)) y
  78.                       :else (recur
  79.                              (loop [iter-y 0
  80.                                     new-y []]
  81.                                (cond (= iter-y (count y)) new-y
  82.                                :else (recur
  83.                                       (inc iter-y)
  84.                                       (into new-y
  85.                                             (append-variants (nth y iter-y)
  86.                                                              (nth x row-x))))))
  87.                              (inc row-x))))))
  88.  
  89.  
  90.  
  91. (part-rows  [x dim]
  92.    (mapv #( vec (partition dim 1 (take dim (repeat :nil)) %)) x))
  93.  
  94.  
  95. (build-grid-base [x FIX]
  96.    (loop [y [(part-rows x 2)]
  97.          dim 3]
  98.     (cond (> dim (min (count x) FIX)) y
  99.           :else (recur (into y [(part-rows x dim)]) (inc dim)))))
  100.  
  101.  
  102. (square-at  [parted-x dim i j]
  103.    (loop [y []
  104.          di 0]
  105.     (cond (= di dim) y
  106.           :else (let [curr-row (nth (nth parted-x (+ i di)) j)]
  107.                   (cond (vec-contains-:nil? curr-row) nil
  108.                         :else (recur (conj y curr-row) (inc di)))))))
  109.  
  110. (transpose  [m]
  111.   (loop [y (map vector (nth m 0))
  112.          i 1]
  113.     (cond (= i (count m)) y
  114.           :else (recur (mapv concat y (map vector (nth m i))) (inc i)))))
  115.  
  116. (max-row-member  [x]
  117.   (reduce max (map #(count (set %)) x)))
  118.  
  119. (min-row-member  [x]
  120.   (reduce min (map #(count (set %)) x)))
  121.  
  122.  
  123. (latin-square?  [s]
  124.   (cond (nil? s) false
  125.         :else (let [dim (count s)]
  126.                 (cond (not= dim (min-row-member s)) false
  127.                       (not= dim (max-row-member s)) false
  128.                       (not= dim (count (set (flatten s)))) false
  129.                       (not= dim (count (set s))) false
  130.                       (not= dim (min-row-len s)) false
  131.                       (not= dim (max-row-len s)) false
  132.                       (not= dim (count (set (transpose s)))) false
  133.                       (not= dim (min-row-member (transpose s))) false
  134.                       (not= dim (max-row-member (transpose s))) false
  135.                       :else true))))
  136.  
  137.  
  138. (count-a-grid-item  [x]
  139.    (let [dim-sq (count (nth (nth x 0) 0))
  140.         dim-x-x (inc (- (count x) dim-sq))
  141.         dim-x-y (count (nth x 0))]
  142.     (loop [sq (square-at x dim-sq 0 0)
  143.            result (cond (latin-square? sq) (conj #{} sq)
  144.                         :else #{})
  145.            i 0
  146.            j 1]
  147.       (cond (= i dim-x-x) result
  148.             :else (recur (cond (and (< i dim-x-x) (< j dim-x-y))
  149.                                (square-at x dim-sq i j)
  150.                                :else sq)
  151.                          (cond (and (< i dim-x-x) (< j dim-x-y))
  152.                                (cond (latin-square? sq) (conj result sq)
  153.                                      :else result)
  154.                                :else result)
  155.                          (cond (= j dim-x-y) (inc i)
  156.                                :else i)
  157.                          (cond (= j dim-x-y) 0
  158.                                :else (inc j)))))))
  159.  
  160.  
  161.  
  162. (solve  [x]
  163.   (let [search-base (build-search-base (fill-x x))
  164.         dim-base (count search-base)
  165.         result (atom [])
  166.         FIX (min-row-len x)]
  167.     (doseq [i (range dim-base)]
  168.       (let [grid-base (build-grid-base (nth search-base i) FIX)]
  169.         (doseq [j (range (count grid-base))]
  170.           (swap!  result into (count-a-grid-item (nth grid-base j))))))
  171.     (set @result)))
  172.  
  173.  
  174. (summary  [lsq]
  175.   (reduce conj {} (for [[x xs]
  176.                         (group-by identity
  177.                                   (sort < (for [r lsq]
  178.                                     (count r))))]
  179.                     [x (count xs)])))]
  180. (summary (solve x)))))
  181.  
  182. (lsq v8)
  183.  
Success #stdin #stdout 2.05s 220288KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/cLGx2u
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!