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

Standard output is empty