Implementing Let-over-lambda Chapter 7 Badger Network For Sorting In Clojure

• Tweet
• 

        // description of your code here

(ns let-over-lambda
  (:use clojure.test)
  (:use clojure.contrib.seq-utils)
  (:use clojure.set)
  (:use [swank.swank :as swank]))
;;;(run-tests)
(import '(java.util Arrays))
(import '(java.lang Integer))

(set! *warn-on-reflection* true)

(swank/start-repl 4005) ;; optionally takes a port argument

(defn floor
   ([p] (floor p 1))
   ([p d] (let [q (quot p d)
                r (rem p d)]
            (if (neg? (* r d))
              (- q 1)
              q))))

(defn ceiling
   ([p] (ceiling p 1))
   ([p d] (let [q (quot p d)
                r (rem p d)]
            (if (pos? (* r d))
              (+ q 1)
              q))))

(defn build-batcher-sn [n]
  (let [network (atom '())
	tee     (ceiling (/ (Math/log n) (Math/log 2)))]
    ;;(println (format "tee: %s" tee))
    (loop [p (bit-shift-left 1 (- tee 1))]
      ;;(println (format "p: %s" p))
      (if (> p 0)
	(do
	  (loop [q (bit-shift-left 1 (- tee 1))
		 r 0
		 d p]
	    ;;(println (format "q: %s r: %s d: %s" q r d))
	    (if (> d 0)
	      (do
		(loop [i 0]
		  (if (<= i (- n d 1))
		    (do
		      ;;(println (format "network: %s i: %s p: %s bit-and: %s r: %s" @network i p (bit-and i p) r))
		      (if (= (bit-and i p) r)
			(swap! network (fn [x] (conj x (list i (+ i d))))))
		      (recur (inc i)))))
		(recur (bit-shift-left q -1) p (- q p)))))
	  (recur (bit-shift-left p -1)))))
    (reverse @network)))
;;; (build-batcher-sn 3)

(defn sn-to-lambda-form-for-int-array [sn]
  (let [arr (gensym "arr")]
    `(fn [~arr]
       ~@(map (fn [[idx1 idx2]]
		`(let [e1# (aget ~arr ~idx1)
		       e2# (aget ~arr ~idx2)]
		   (if (> e1# e2#) ;;(> e1# e2#) ;;(== 1 (.compareTo e1# e2#)) 
		     (do
		       (aset-int ~arr ~idx2 e1#)
		       (aset-int ~arr ~idx1 e2#)))))
	      sn)
       ~arr)))

;;;(eval (sn-to-lambda-form-for-int-array bad-3-sn))
;;;(into [] (seq ((eval (sn-to-lambda-form-for-int-array bad-3-sn)) (int-array [3 1 2]))))

(defn create-random-int-array [size]
  (into [] (map (fn [_] (rand-int 100000)) (range size))))

(defn sort-timing-test-int-array []
  (let [iterations   (int 10000)
	sample-size  (int 50)
	sort-fn      (eval (sn-to-lambda-form-for-int-array (build-batcher-sn sample-size))) ;; create a compiled function
	sample-array (int-array (create-random-int-array sample-size))
	]
    (do
      (dotimes [_ iterations]  ;; warm-up
	(Arrays/sort (aclone sample-array)))
      (time
       (dotimes [_ iterations] ;; real-run
	 (Arrays/sort (aclone sample-array)))))
    (do
      (dotimes [_ iterations]  ;; warm-up
	(sort-fn (aclone sample-array)))
      (time
       (dotimes [_ iterations] ;; real-run
	 (sort-fn (aclone sample-array)))))))

;;;(sort-timing-test-int-array)

(defn sn-to-lambda-form-for-compareable-objects [sn]
  (let [arr        (gensym "arr")
	fn-compare (gensym "fn-compare")]
    `(fn [~arr ~fn-compare]
       ~@(map (fn [[idx1 idx2]]
		`(let [e1# (aget ~arr ~idx1)
		       e2# (aget ~arr ~idx2)]
		   (if (== 1 (~fn-compare e1# e2#))
		     (do
		       (aset ~arr ~idx2 e1#)
		       (aset ~arr ~idx1 e2#)))))
	      sn)
       ~arr)))

(defn compare-integers [#^Integer i1 #^Integer i2]
  (.compareTo i1 i2))

(defn sort-timing-test-integer-array []
  (let [iterations   (int 10000)
	sample-size  (int 50)
	sort-fn      (eval (sn-to-lambda-form-for-compareable-objects (build-batcher-sn sample-size))) ;; create a compiled function
	sample-array (to-array (create-random-int-array sample-size))
	]
    (do
      (dotimes [_ iterations]  ;; warm-up
	(Arrays/sort (aclone sample-array)))
      (time
       (dotimes [_ iterations] ;; real-run
	 (Arrays/sort (aclone sample-array)))))
    (do
      (dotimes [_ iterations]  ;; warm-up
    	(sort-fn (aclone sample-array) compare-integers))
      (time
       (dotimes [_ iterations] ;; real-run
    	 (sort-fn (aclone sample-array) compare-integers))))
    ))
;;;(sort-timing-test-integer-array)

Tags:
• badger
• clojure
• let-over-lambda
• sort network