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. (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
stdin
Standard input is empty
stdout

Standard output is empty