]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_42_new.clj
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / ex2_42_new.clj
1 (ns sicp.ex2_42_new
2   (:use [sicp.ch2-2 :only (enumerate-interval accumulate append flatmap)]))
3
4 (declare safe? empty-board adjoin-position)
5
6 (defn queens [board-size]
7   (let [f (fn queen-cols [k]
8             (if (= k 0)
9               (list empty-board)
10               (filter
11                (fn [positions] (safe? k positions))
12                (flatmap
13                 (fn [rest-of-queens]
14                   (map (fn [new-row]
15                          (adjoin-position new-row k rest-of-queens))
16                        (enumerate-interval 1 board-size)))
17                 (queen-cols (- k 1))))))]
18     (f board-size)))
19
20 (def empty-board nil)
21
22 (defn adjoin-position [row col positions]
23   (append positions (list (list row col))))
24
25 (defn get-row [p]
26   (first p))
27
28 (defn get-col [p]
29   (second p))
30
31 (defn same-row? [p q]
32   (= (get-row p)
33      (get-row q)))
34
35 (defn same-col? [p q]
36   (= (get-col p)
37      (get-col q)))
38
39 (defn same-diag? [p q]
40   (= (Math/abs (- (get-row p) (get-row q)))
41      (Math/abs (- (get-col p) (get-col q)))))
42
43 (defn under-attack? [p q]
44   (or (same-row? p q)
45       (same-col? p q)
46       (same-diag? p q)))
47
48 (defn safe? [col positions]
49   (loop [this-pos (nth positions (- col 1))
50          rest-pos (remove #(= this-pos %) positions)]
51     (if (empty? rest-pos)
52       true
53       (let [new-pos (first rest-pos)]
54         (if (under-attack? this-pos new-pos)
55           false
56           (recur this-pos (rest rest-pos)))))))