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)))))))