Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

added more tests, added grid lines to display, refactorings

  • Loading branch information...
commit e233e4250184bcbbb0da942d10b73f6e11f0d144 1 parent d7bfc44
@bitsai authored
Showing with 120 additions and 102 deletions.
  1. +97 −0 algorithm.clj
  2. +3 −99 sudoku.clj
  3. +7 −3 tests.clj
  4. +13 −0 utils.clj
View
97 algorithm.clj
@@ -0,0 +1,97 @@
+(ns algorithm
+ (:require [clojure.string :as str])
+ (:use [clojure.java.io :only (reader)])
+ (:use utils))
+
+(defn cross [A B]
+ (for [a A b B] (str a b)))
+
+(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 (for [u unitlist :when (in? s u)] u)])))
+(def peers
+ (into {} (for [s squares] [s (set (remove #{s} (flatten (units s))))])))
+
+(defn set-values! [values s s-values]
+ (dosync (alter values #(assoc-in % [s] s-values))))
+
+(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)) false
+ (false? (helper-2 values s d)) false
+ :else values))))
+
+;; If a square s is reduced to 1 value d2, then eliminate d2 from the peers.
+(defn helper-1 [values s]
+ (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))
+
+;; If a unit u is reduced to only 1 place for a value d, then put it there.
+(defn helper-2 [values s d]
+ (all? (for [u (units s)]
+ (let [dplaces (for [s u :when (in? d (@values s))] s)]
+ (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 [values-strs (for [s squares] (apply str (@values s)))
+ rows (partition 9 values-strs)
+ lines (for [r rows] (str/join " " (interpose-nth 3 "|" r)))]
+ (doseq [line (interpose-nth 3 "---------------------" lines)]
+ (println line))))
+
+(defn search [values]
+ (cond
+ (false? values) false
+ (all? (for [s squares] (= 1 (count (@values s))))) values
+ :else (let [unfilled (for [s squares :when (> (count (@values s)) 1)] s)
+ s (apply min-key #(count (@values %)) unfilled)]
+ (some #(search (assign (copy values) s %)) (@values s)))))
+
+(defn solve-grid [grid]
+ (search (parse-grid grid)))
+
+(defn solve-file [file]
+ (with-open [rdr (reader file)]
+ (let [lines (line-seq rdr)
+ grid (str/join lines)]
+ (solve-grid grid))))
View
102 sudoku.clj
@@ -1,101 +1,5 @@
(ns sudoku
- (:use [clojure.java.io :only (reader)])
- (:use [clojure.string :only (join)]))
+ (:use algorithm))
-(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)))
-
-(with-open [rdr (reader (first *command-line-args*))]
- (let [lines (line-seq rdr)
- grid (join lines)]
- (display (solve grid))))
+(let [file (first *command-line-args*)]
+ (display (solve-file file)))
View
10 tests.clj
@@ -1,5 +1,5 @@
-(ns sudoku-tests
- (:use [sudoku])
+(ns tests
+ (:use algorithm)
(:use [clojure.test :only (deftest is run-tests)]))
(deftest sudoku-tests
@@ -12,6 +12,10 @@
("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"})))
+ "A1" "A3" "B1" "B3"}))
+ (is (= @(solve-file "airplane_puzzle.txt") '{"I1" (\7), "H1" (\9), "I2" (\1), "G1" (\5), "H2" (\8), "I3" (\6), "F1" (\3), "G2" (\2), "H3" (\3), "I4" (\2), "E1" (\2), "F2" (\9), "G3" (\4), "H4" (\1), "I5" (\3), "D1" (\4), "E2" (\6), "F3" (\8), "G4" (\6), "H5" (\7), "I6" (\4), "C1" (\6), "D2" (\7), "E3" (\5), "F4" (\7), "G5" (\9), "H6" (\5), "I7" (\5), "B1" (\1), "C2" (\4), "D3" (\1), "E4" (\4), "F5" (\6), "G6" (\8), "H7" (\4), "I8" (\8), "A1" (\8), "B2" (\3), "C3" (\7), "D4" (\5), "E5" (\8), "F6" (\1), "G7" (\1), "H8" (\2), "I9" (\9), "A2" (\5), "B3" (\9), "C4" (\3), "D5" (\2), "E6" (\3), "F7" (\2), "G8" (\3), "H9" (\6), "A3" (\2), "B4" (\8), "C5" (\1), "D6" (\9), "E7" (\9), "F8" (\5), "G9" (\7), "A4" (\9), "B5" (\5), "C6" (\2), "D7" (\3), "E8" (\7), "F9" (\4), "A5" (\4), "B6" (\6), "C7" (\8), "D8" (\6), "E9" (\1), "A6" (\7), "B7" (\7), "C8" (\9), "D9" (\8), "A7" (\6), "B8" (\4), "C9" (\5), "A8" (\1), "B9" (\2), "A9" (\3)}))
+ (is (= @(solve-file "easy_puzzle.txt") '{"I1" (\6), "H1" (\8), "I2" (\9), "G1" (\3), "H2" (\1), "I3" (\5), "F1" (\1), "G2" (\7), "H3" (\4), "I4" (\4), "E1" (\7), "F2" (\3), "G3" (\2), "H4" (\2), "I5" (\1), "D1" (\5), "E2" (\2), "F3" (\6), "G4" (\6), "H5" (\5), "I6" (\7), "C1" (\2), "D2" (\4), "E3" (\9), "F4" (\7), "G5" (\8), "H6" (\3), "I7" (\3), "B1" (\9), "C2" (\5), "D3" (\8), "E4" (\5), "F5" (\9), "G6" (\9), "H7" (\7), "I8" (\8), "A1" (\4), "B2" (\6), "C3" (\1), "D4" (\1), "E5" (\6), "F6" (\8), "G7" (\5), "H8" (\6), "I9" (\2), "A2" (\8), "B3" (\7), "C4" (\8), "D5" (\3), "E6" (\4), "F7" (\2), "G8" (\1), "H9" (\9), "A3" (\3), "B4" (\3), "C5" (\7), "D6" (\2), "E7" (\1), "F8" (\4), "G9" (\4), "A4" (\9), "B5" (\4), "C6" (\6), "D7" (\9), "E8" (\3), "F9" (\5), "A5" (\2), "B6" (\5), "C7" (\4), "D8" (\7), "E9" (\8), "A6" (\1), "B7" (\8), "C8" (\9), "D9" (\6), "A7" (\6), "B8" (\2), "C9" (\3), "A8" (\5), "B9" (\1), "A9" (\7)}))
+ (is (= @(solve-file "hard_puzzle.txt") '{"I1" (\1), "H1" (\5), "I2" (\6), "G1" (\2), "H2" (\7), "I3" (\4), "F1" (\3), "G2" (\8), "H3" (\3), "I4" (\8), "E1" (\7), "F2" (\4), "G3" (\9), "H4" (\2), "I5" (\7), "D1" (\8), "E2" (\9), "F3" (\6), "G4" (\6), "H5" (\9), "I6" (\5), "C1" (\9), "D2" (\2), "E3" (\1), "F4" (\9), "G5" (\4), "H6" (\1), "I7" (\2), "B1" (\6), "C2" (\5), "D3" (\5), "E4" (\5), "F5" (\1), "G6" (\3), "H7" (\6), "I8" (\9), "A1" (\4), "B2" (\3), "C3" (\8), "D4" (\4), "E5" (\8), "F6" (\2), "G7" (\5), "H8" (\8), "I9" (\3), "A2" (\1), "B3" (\2), "C4" (\7), "D5" (\3), "E6" (\6), "F7" (\7), "G8" (\7), "H9" (\4), "A3" (\7), "B4" (\1), "C5" (\2), "D6" (\7), "E7" (\4), "F8" (\5), "G9" (\1), "A4" (\3), "B5" (\5), "C6" (\4), "D7" (\1), "E8" (\3), "F9" (\8), "A5" (\6), "B6" (\8), "C7" (\3), "D8" (\6), "E9" (\2), "A6" (\9), "B7" (\9), "C8" (\1), "D9" (\9), "A7" (\8), "B8" (\4), "C9" (\6), "A8" (\2), "B9" (\7), "A9" (\5)}))
+ (is (= @(solve-file "harder_puzzle.txt") '{"I1" (\3), "H1" (\2), "I2" (\5), "G1" (\4), "H2" (\8), "I3" (\1), "F1" (\1), "G2" (\6), "H3" (\7), "I4" (\9), "E1" (\5), "F2" (\3), "G3" (\9), "H4" (\3), "I5" (\4), "D1" (\7), "E2" (\2), "F3" (\4), "G4" (\1), "H5" (\5), "I6" (\7), "C1" (\8), "D2" (\9), "E3" (\6), "F4" (\5), "G5" (\2), "H6" (\6), "I7" (\6), "B1" (\9), "C2" (\4), "D3" (\8), "E4" (\4), "F5" (\8), "G6" (\8), "H7" (\1), "I8" (\2), "A1" (\6), "B2" (\1), "C3" (\5), "D4" (\2), "E5" (\7), "F6" (\9), "G7" (\7), "H8" (\4), "I9" (\8), "A2" (\7), "B3" (\2), "C4" (\6), "D5" (\6), "E6" (\3), "F7" (\2), "G8" (\3), "H9" (\9), "A3" (\3), "B4" (\7), "C5" (\1), "D6" (\1), "E7" (\8), "F8" (\6), "G9" (\5), "A4" (\8), "B5" (\3), "C6" (\2), "D7" (\3), "E8" (\9), "F9" (\7), "A5" (\9), "B6" (\5), "C7" (\9), "D8" (\5), "E9" (\1), "A6" (\4), "B7" (\4), "C8" (\7), "D9" (\4), "A7" (\5), "B8" (\8), "C9" (\3), "A8" (\1), "B9" (\6), "A9" (\2)})))
(run-tests)
View
13 utils.clj
@@ -0,0 +1,13 @@
+(ns utils)
+
+(defn all? [coll]
+ (not-any? false? coll))
+
+(defn in? [x coll]
+ (some #{x} coll))
+
+(defn copy [reference]
+ (ref @reference))
+
+(defn interpose-nth [n sep coll]
+ (apply concat (interpose [sep] (partition n coll))))
Please sign in to comment.
Something went wrong with that request. Please try again.