two solutions to 2.42
authorRamakrishnan Muthukrishnan <vu3rdd@gmail.com>
Sat, 14 Aug 2010 06:33:19 +0000 (12:03 +0530)
committerRamakrishnan Muthukrishnan <vu3rdd@gmail.com>
Sat, 14 Aug 2010 06:33:19 +0000 (12:03 +0530)
src/sicp/ex2_42.clj [new file with mode: 0644]
src/sicp/ex2_42_new.clj [new file with mode: 0644]

diff --git a/src/sicp/ex2_42.clj b/src/sicp/ex2_42.clj
new file mode 100644 (file)
index 0000000..9702613
--- /dev/null
@@ -0,0 +1,39 @@
+(ns sicp.ex2_42
+  (:use [sicp.ch2-2 :only (enumerate-interval accumulate append flatmap)]))
+
+(declare safe? empty-board adjoin-position)
+
+(defn queens [board-size]
+  (let [f (fn queen-cols [k]
+            (if (= k 0)
+              (list empty-board)
+              (filter
+               (fn [positions] (safe? k positions))
+               (flatmap
+                (fn [rest-of-queens]
+                  (map (fn [new-row]
+                         (adjoin-position new-row k rest-of-queens))
+                       (enumerate-interval 1 board-size)))
+                (queen-cols (- k 1))))))]
+    (f board-size)))
+
+(def empty-board nil)
+
+(defn adjoin-position [row col pos]
+  (cons row pos))
+
+(defn get-row [pos]
+  (first pos))
+
+(defn safe? [col positions]
+  (loop [this-row (first positions)
+         pos      (rest positions)
+         offset  1]
+    (if (empty? pos)
+      true
+      (let [new-row (first pos)]
+        (if (or (= this-row new-row)
+                (= (+ this-row offset) new-row)
+                (= (- this-row offset) new-row))
+          false
+          (recur this-row (rest pos) (inc offset)))))))
\ No newline at end of file
diff --git a/src/sicp/ex2_42_new.clj b/src/sicp/ex2_42_new.clj
new file mode 100644 (file)
index 0000000..b10684a
--- /dev/null
@@ -0,0 +1,56 @@
+(ns sicp.ex2_42_new
+  (:use [sicp.ch2-2 :only (enumerate-interval accumulate append flatmap)]))
+
+(declare safe? empty-board adjoin-position)
+
+(defn queens [board-size]
+  (let [f (fn queen-cols [k]
+            (if (= k 0)
+              (list empty-board)
+              (filter
+               (fn [positions] (safe? k positions))
+               (flatmap
+                (fn [rest-of-queens]
+                  (map (fn [new-row]
+                         (adjoin-position new-row k rest-of-queens))
+                       (enumerate-interval 1 board-size)))
+                (queen-cols (- k 1))))))]
+    (f board-size)))
+
+(def empty-board nil)
+
+(defn adjoin-position [row col positions]
+  (append positions (list (list row col))))
+
+(defn get-row [p]
+  (first p))
+
+(defn get-col [p]
+  (second p))
+
+(defn same-row? [p q]
+  (= (get-row p)
+     (get-row q)))
+
+(defn same-col? [p q]
+  (= (get-col p)
+     (get-col q)))
+
+(defn same-diag? [p q]
+  (= (Math/abs (- (get-row p) (get-row q)))
+     (Math/abs (- (get-col p) (get-col q)))))
+
+(defn under-attack? [p q]
+  (or (same-row? p q)
+      (same-col? p q)
+      (same-diag? p q)))
+
+(defn safe? [col positions]
+  (loop [this-pos (nth positions (- col 1))
+         rest-pos (remove #(= this-pos %) positions)]
+    (if (empty? rest-pos)
+      true
+      (let [new-pos (first rest-pos)]
+        (if (under-attack? this-pos new-pos)
+          false
+          (recur this-pos (rest rest-pos)))))))
\ No newline at end of file