| |
|
| | (ns e2-40-to-43
(:use clojure.test)
(:use [util.util :only (zip, permutations, exists)])
(:use [clojure.contrib.generic.math-functions :only (sqrt, round)])
(:use [clojure.contrib.seq-utils :only (flatten)]))
|
| | (defn enum [a b]
(take b (iterate #(+ 1 %1) a)))
|
| | (deftest test-enum
(is (= (enum 1 6) [1 2 3 4 5 6])))
|
| | (defn unique-pairs [n]
(let [nums (enum 1 n)]
(filter (fn [x] (> (first x) (second x)))
; this doesn't work - I guess you can't repeat macro arguments several times
;(filter #((> (first %1) (second %1)))
(mapcat #(map (fn [x] (list x %1)) nums) nums))))
|
| | (deftest test-unique-pairs
(is (= (sort-by #(first %1) (unique-pairs 3)) [[2 1] [3 1] [3 2]])))
|
| | (defn any? [p xs]
(not (empty? (filter p xs))))
|
| | (defn prime? [n]
(empty? (filter #(= (rem n %1) 0)
(enum 2 (round (sqrt n))))))
|
| | (defn prime-sum? [pair]
(prime? (+ (first pair) (second pair))))
|
| | (defn make-pair-sum [pair]
; aaargh... the verbosity
(list (first pair) (second pair) (+ (first pair) (second pair))))
|
| | (defn prime-sum-pairs [n]
(map make-pair-sum
(filter prime-sum? (unique-pairs n))))
|
| | (deftest test-prime-sum
(is (= (prime-sum-pairs 3) [[3 2 5]]))
(is (= (sort-by #(first %1) (prime-sum-pairs 5)) [[3 2 5] [4 1 5] [4 3 7] [5 2 7]])))
|
| | (defn len [xs]
(reduce (fn [acc el] (+ acc 1)) 0 xs))
|
| | (defn increasing? [xs]
(second (reduce (fn [[prev res] el] (if (or (not res) (> prev el))
[prev false]
[el true]))
[(first xs) true] ; initial value
xs)))
@param n - upper bound of the range
@param k - size of the tuple with 1 <= I(1) < I(2) < ... < I(k) <= n
| | (defn unique-ks
[n k]
(let [nums (enum 1 n)]
(filter #(increasing? %)
; in uniq-pairs we took an [a] and created an [(a, a)] out of it.
; in the generic case we need to create a list of n-tuples of type a.
(set (map #(take k %) (permutations nums))))))
|
| | (defn- sum [xs]
(reduce + 0 xs))
|
| | (defn unique-triples [n s]
(if (< n 3) []
(filter #(= (sum %) s) (unique-ks n 3))))
|
| | (deftest test-unique-triples
(is (= (unique-triples 3 6) [[1 2 3]]))
(is (= (unique-triples 4 6) [[1 2 3]]))
(is (= (unique-triples 5 9) [[2 3 4] [1 3 5]])))
|
| | (def *board-start* 0)
(def *board-size* 5)
(take board-size (repeat (enum board-start board-size))))
It should produce an empty set of positions.
| | (def empty-board ())
|
| | (defn at-x [pos] (first pos))
(defn at-y [pos] (second pos))
(defn pos [x y] [x y])
(defn outside-board? [pos]
(or (> (at-x pos) *board-size*)
(< (at-x pos) *board-start*)
(> (at-y pos) *board-size*)
(< (at-y pos) *board-start*)))
|
| | (defn- generate-path [f init]
(take-while #(not (outside-board? %)) (iterate f init)))
|
| | (defmulti path-to (fn [dir init] dir))
(defmethod path-to :up-right [_ init]
(generate-path (fn [init] (pos (inc (at-x init)) (inc (at-y init)))) init))
(defmethod path-to :up-left [_ init]
(generate-path (fn [init] (pos (dec (at-x init)) (inc (at-y init)))) init))
(defmethod path-to :down-right [_ init]
(generate-path (fn [init] (pos (inc (at-x init)) (dec (at-y init)))) init))
(defmethod path-to :down-left [_ init]
(generate-path (fn [init] (pos (dec (at-x init)) (dec (at-y init)))) init))
|
| | (defn- exact-queen-hit [who whom]
(cond (= who whom) true
:else (or
; this could have been easily checked by checking the slope of the
; line formed by two queens (kx + a = y, hits if k = 1).
(contains? (set (concat (path-to :up-right who)
(path-to :up-left who)
(path-to :down-right who)
(path-to :down-left who)))
whom))))
@param who - the queen doing the beating
@param whom - the queen getting beaten
| | (defn queen-hits
[who whom]
;{:pre [(assert (> (at-x whom) (at-x who)))]} -- doesn't work
; check same horizontal (cannot be the same vertical)
(cond (= (at-y who) (at-y whom)) true
(= (at-x who) (at-x whom)) true
:else (exact-queen-hit who whom)))
|
| | (deftest test-hits
(is (queen-hits (pos 1 1) (pos 2 2)))
(is (queen-hits (pos 2 2) (pos 1 1)))
(is (queen-hits (pos 1 1) (pos 2 1)))
(is (queen-hits (pos 2 1) (pos 1 1)))
(is (not (queen-hits (pos 1 1) (pos 2 3))))
(is (not (queen-hits (pos 2 3) (pos 1 1)))))
|
| | (defn get-queen-at-column [column positions]
(let [result (filter #(= (at-y %) column) positions)]
(if (empty? result) nil (first result))))
|
| | (defn safe?
#^{:doc " @param k - vertical of the current queen
@param positions - positions of queens in verticals 1..(k-1).
Type: List (Int, Int)
@return true if the position at index k is safe " }
;:test (fn [] (assert (and (k >= *board-start*) (>= (count positions) k)))) }
[column positions]
(let [at-column (get-queen-at-column column positions)]
(not (exists #(queen-hits % at-column) (remove #(= % at-column) (vec positions))))))
|
| | (deftest test-safe
(is (not (safe? 1 [(pos 0 0) (pos 1 1)])))
(is (not (safe? 1 [(pos 0 0) (pos 1 1) (pos 2 3)])))
(is (safe? 3 [(pos 0 0) (pos 1 3) (pos 2 1)])))
@param new-row - horizontal for the new queen
@param new-column - vertical for the new queen
@param queens-already-placed - queens placed before this queen. They are
guaranteed to be placed correctly
| | (defn add-queen
[new-row new-column queens-already-placed]
(cons (pos new-row new-column) queens-already-placed))
|
| | (def queens
(letfn [(queen-cols [column]
(if (= column (dec *board-start*))
(list empty-board)
(filter #(safe? column %)
(mapcat (fn [queens-already-placed]
(map #(add-queen % column queens-already-placed)
(enum *board-start* *board-size*)))
(queen-cols (dec column))))))]
(queen-cols (dec *board-size*))))
|
| | (defn print-queens [positions]
(doseq [y (reverse (enum *board-start* *board-size*))]
(doseq [x (enum *board-start* *board-size*)]
(if (contains? (set positions) (pos x y))
(print "*")
(print ".")))
(print "\n")))
|
| | (defn failed-queens [_] ; unused parameter so that this would be a valid function definition
(letfn [(queen-cols [column]
(if (= column (dec *board-start*))
(list empty-board)
(filter #(safe? column %)
(mapcat (fn [row]
(map #(add-queen row column %)
(queen-cols (dec column))))
(enum *board-start* *board-size*)))))]
(queen-cols (dec *board-size*))))
| | |