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