From: Ramakrishnan Muthukrishnan Date: Sat, 14 Aug 2010 06:33:19 +0000 (+0530) Subject: two solutions to 2.42 X-Git-Url: https://git.rkrishnan.org/listings/specifications/frontends/FTP-and-SFTP.rst?a=commitdiff_plain;h=dfb84009ce77c132bfa1b701b6893c98066db23e;p=sicp.git two solutions to 2.42 --- diff --git a/src/sicp/ex2_42.clj b/src/sicp/ex2_42.clj new file mode 100644 index 0000000..9702613 --- /dev/null +++ b/src/sicp/ex2_42.clj @@ -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 index 0000000..b10684a --- /dev/null +++ b/src/sicp/ex2_42_new.clj @@ -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