Source

metaljoe_codekata / code_kata_2e.clj

Full commit
; http://codekata.pragprog.com/2007/01/kata_two_karate.html

; ------------------------------------------------------------
;  Algorithm taken from Programming Pearls, 2nd Edition, p.36
;   written by Jon Bentley, published by Addison Wesley
; ------------------------------------------------------------

(ns code-kata)


(defmacro mid []
  (list 'quot '(+ lower upper) 2) )

(defmacro get-mid []
  (list 'get 'list '(mid)))

(defmacro get-upper []
  (list '- '(count list) 1 ))

(defmacro look-left []
  (list 'recur 'lower '(- (mid) 1)))

(defmacro look-right []
  (list 'recur '(+ (mid) 1) 'upper ))

(defmacro search-exhausted []
  (list '> 'lower 'upper))

(defn
  #^{:test (fn []
			 (assert (= -1 (chop 3 []) ))
			 (assert (= -1 (chop 3 [1]) ))
			 (assert (=  0 (chop 1 [1]) ))

			 (assert (=  0 (chop 1 [1 3 5]) ))
			 (assert (=  1 (chop 3 [1 3 5]) ))
			 (assert (=  2 (chop 5 [1 3 5]) ))
			 (assert (= -1 (chop 0 [1 3 5]) ))
			 (assert (= -1 (chop 2 [1 3 5]) ))
			 (assert (= -1 (chop 4 [1 3 5]) ))
			 (assert (= -1 (chop 6 [1 3 5]) ))

			 (assert (=  0 (chop 1 [1 3 5 7]) ))
			 (assert (=  1 (chop 3 [1 3 5 7]) ))
			 (assert (=  2 (chop 5 [1 3 5 7]) ))
			 (assert (=  3 (chop 7 [1 3 5 7]) ))
			 (assert (= -1 (chop 0 [1 3 5 7]) ))
			 (assert (= -1 (chop 2 [1 3 5 7]) ))
			 (assert (= -1 (chop 4 [1 3 5 7]) ))
			 (assert (= -1 (chop 6 [1 3 5 7]) ))
			 (assert (= -1 (chop 8 [1 3 5 7]) )) ) }
  chop
  [item list]
  (loop [ lower 0
          upper (get-upper) ]
	(if (search-exhausted)
	  -1
	  (if (< (get-mid) item)
		(look-right)
		(if (= (get-mid) item)
		  (mid)
		  (look-left))))))

(test #'chop)