Skip to content
Browse files

add Clojure solver

  • Loading branch information...
1 parent ae0f41f commit 8fbd9ac30a7ea387ef9631e35339a31fd4c2653d @bitsai committed Oct 20, 2010
Showing with 134 additions and 1 deletion.
  1. +2 −1 README
  2. +115 −0 sudoku.clj
  3. +17 −0 tests.clj
View
3 README
@@ -1,5 +1,6 @@
Source:
http://norvig.com/sudoku.html
-To solve a puzzle, save it in a file (see the sample puzzle files for format), then run:
+To solve a puzzle, save it in a file (see the sample puzzle files for format), then run one of:
+clj sudoku.clj <puzzle file>
ruby sudoku.rb <puzzle file>
View
115 sudoku.clj
@@ -0,0 +1,115 @@
+(ns sudoku
+ (:use [clojure.string :only (join)]))
+
+(defn cross [A B]
+ (for [a A, b B] (str a b)))
+
+(defn all? [coll]
+ (every? #(not (false? %)) coll))
+
+(defn in? [x coll]
+ (some #{x} coll))
+
+(defn set-values! [values s s-values]
+ (dosync (alter values #(assoc-in % [s] s-values))))
+
+(defn copy [reference]
+ (ref @reference))
+
+(def digits "123456789")
+(def rows "ABCDEFGHI")
+(def cols digits)
+(def squares (cross rows cols))
+(def unitlist
+ (concat
+ (for [c cols] (cross rows (str c)))
+ (for [r rows] (cross (str r) cols))
+ (for [rs (partition 3 rows) cs (partition 3 cols)] (cross rs cs))))
+(def units
+ (into {} (for [s squares] [s (filter #(in? s %) unitlist)])))
+(def peers
+ (into {} (for [s squares] [s (set (remove #{s} (flatten (units s))))])))
+
+(declare assign eliminate helper-1 helper-2)
+
+(defn assign [values s d]
+ (let [other-values (remove #{d} (@values s))]
+ (if (all? (for [d2 other-values] (eliminate values s d2)))
+ values
+ false)))
+
+(defn eliminate [values s d]
+ (if-not (in? d (@values s))
+ values
+ (let [other-values (remove #{d} (@values s))]
+ (set-values! values s other-values)
+ (cond
+ (false? (helper-1 values s d)) false
+ (false? (helper-2 values s d)) false
+ :else values))))
+
+(defn helper-1 [values s d]
+ (case (count (@values s))
+ 0 false
+ 1 (let [d2 (first (@values s))]
+ (if-not (all? (for [s2 (peers s)] (eliminate values s2 d2)))
+ false
+ true))
+ true))
+
+(defn helper-2 [values s d]
+ (all? (for [u (units s)]
+ (let [dplaces (filter #(in? d (@values %)) u)]
+ (case (count dplaces)
+ 0 false
+ 1 (if-not (assign values (first dplaces) d)
+ false
+ true)
+ true)))))
+
+(defn grid-values [grid]
+ (zipmap squares grid))
+
+(defn parse-grid [grid]
+ (let [values (ref (into {} (for [s squares] [s digits])))]
+ (if-not (all? (for [[s d] (grid-values grid) :when (in? d digits)]
+ (assign values s d)))
+ false
+ values)))
+
+(defn display [values]
+ (let [lines (for [r rows]
+ (let [strs (for [c cols] (apply str (@values (str r c))))]
+ (join " " strs)))]
+ (println (join "\n" lines))))
+
+(defn search [values]
+ (cond
+ (false? values) false
+ (all? (for [s squares] (= 1 (count (@values s))))) values
+ :else (let [unfilled-squares (filter #(< 1 (count (@values %))) squares)
+ s (apply min-key #(count (@values %)) unfilled-squares)]
+ (some #(search (assign (copy values) s %)) (@values s)))))
+
+(defn solve [grid]
+ (search (parse-grid grid)))
+
+(display (solve (str "003020600"
+ "900305001"
+ "001806400"
+ "008102900"
+ "700000008"
+ "006708200"
+ "002609500"
+ "800203009"
+ "005010300")))
+
+(display (solve (str "300200000"
+ "000107000"
+ "706030500"
+ "070009080"
+ "900020004"
+ "010800050"
+ "009040301"
+ "000702000"
+ "000008006")))
View
17 tests.clj
@@ -0,0 +1,17 @@
+(ns sudoku-tests
+ (:use [sudoku])
+ (:use [clojure.test :only (deftest is run-tests)]))
+
+(deftest sudoku-tests
+ (is (= (count squares) 81))
+ (is (= (count unitlist) 27))
+ (is (every? true? (for [s squares] (= (count (units s)) 3))))
+ (is (every? true? (for [s squares] (= (count (peers s)) 20))))
+ (is (= (units "C2") '(("A2" "B2" "C2" "D2" "E2" "F2" "G2" "H2" "I2")
+ ("C1" "C2" "C3" "C4" "C5" "C6" "C7" "C8" "C9")
+ ("A1" "A2" "A3" "B1" "B2" "B3" "C1" "C2" "C3"))))
+ (is (= (peers "C2") #{"A2" "B2" "D2" "E2" "F2" "G2" "H2" "I2"
+ "C1" "C3" "C4" "C5" "C6" "C7" "C8" "C9"
+ "A1" "A3" "B1" "B3"})))
+
+(run-tests)

0 comments on commit 8fbd9ac

Please sign in to comment.
Something went wrong with that request. Please try again.