Permalink
Browse files

Add to get up to date

  • Loading branch information...
1 parent 4a4a816 commit bf2e04502da88e4ecba8d4e4ffe9012f3984d451 @fffej committed Sep 11, 2009
Showing with 114 additions and 16 deletions.
  1. +37 −0 bitarray.clj
  2. +48 −0 bloom.clj
  3. +20 −8 mandlebrot.clj
  4. +9 −8 raytrace.clj
View
@@ -0,0 +1,37 @@
+(ns bitarray
+ (:use clojure.test))
+
+(defstruct bit-field :element-width :array-data)
+
+(defn bit-array
+ [n]
+ (struct bit-field 31 (int-array (inc (int (/ n 31))))))
+
+(defn set-bit!
+ [bitfield bit val]
+ (let [r (mod bit (bitfield :element-width))
+ n (int (/ bit (bitfield :element-width)))
+ x (aget (bitfield :array-data) n)]
+ (if (not (zero? val))
+ (aset (bitfield :array-data) n (bit-or x (bit-shift-left 1 r)))
+ (aset (bitfield :array-data) n (bit-xor x (bit-shift-left 1 r))))
+ bitfield))
+
+(defn get-bit
+ [bitfield bit]
+ (let [r (mod bit (bitfield :element-width))
+ x (aget (bitfield :array-data) (int (/ bit (bitfield :element-width))))]
+ (if (= 0 (bit-and x (bit-shift-left 1 r))) 0 1)))
+
+(deftest test-bits
+ (let [n 32
+ f (bit-array n)]
+ (is (= 31 (f :element-width)))
+ (doseq [x (range 0 n)]
+ (is (= 0 (get-bit f x))))
+ (doseq [x (reverse (range 0 n))]
+ (set-bit! f x 1)
+ (is (= 1 (get-bit f x))))
+ (doseq [x (range 0 n)]
+ (set-bit! f x 0)
+ (is (= 0 (get-bit f x))))))
View
@@ -0,0 +1,48 @@
+(ns bloom
+ (:use bitarray)
+ (:use clojure.test)
+ (:import (java.security MessageDigest)))
+
+(defn pad [n s]
+ (let [padding (- n (count s))]
+ (apply str (concat (apply str (repeat padding "0")) s))))
+
+(defn md5-hash [s]
+ (let [m (MessageDigest/getInstance "MD5")]
+ (.update m (.getBytes (str s)) 0 (count s))
+ (let [x (.toString (BigInteger. 1 (.digest m)) 16)]
+ (pad 32 x))))
+
+(def md5-hashes
+ (list
+ (fn [x] (BigInteger. (apply str (take 3 (md5-hash x))) 16))
+ (fn [x] (BigInteger. (apply str (take 3 (drop 4 (md5-hash x)))) 16))
+ (fn [x] (BigInteger. (apply str (take 3 (drop 8 (md5-hash x)))) 16))
+ (fn [x] (BigInteger. (apply str (take 3 (drop 12 (md5-hash x)))) 16))))
+
+(defstruct bloom-filter :hashfns :value)
+
+(defn make-bloom-filter
+ ([n] (struct bloom-filter md5-hashes (bit-array n)))
+ ([n fns] (struct bloom-filter fns (bit-array n))))
+
+(defn add!
+ [bloom n]
+ (let [hashes (map (fn [x] (x n)) (bloom :hashfns))]
+ (doseq [x hashes] (set-bit! (bloom :value) x 1))
+ bloom))
+
+(defn query
+ [bloom n]
+ (let [hashes (map (fn [x] (x n)) (bloom :hashfns))]
+ (reduce bit-and (map (fn [z] (get-bit (bloom :value) z)) hashes))))
+
+(deftest test-bloom
+ (let [teststrs (map (fn [x] (str x)) (range 0 1000))
+ bloom (make-bloom-filter 0xFFF)]
+ (doseq [x teststrs]
+ (is (= 0 (query bloom x)))
+ (add! bloom x)
+ (is (= 0 (query bloom (str "not" x))))
+ (is (query bloom x)))))
+
View
@@ -6,8 +6,8 @@
'(java.awt.image BufferedImage MemoryImageSource))
(def *max-iteration* 256)
-(def *width* 128)
-(def *height* 128)
+(def *width* 1024)
+(def *height* 1024)
(defn process-pixel [x y]
((fn [x y xc yc accum]
@@ -19,15 +19,27 @@
(> sq 2.0) accum
:else (recur x1 y1 xc yc (inc accum))))) x y x y 0))
-(defn calculate-pixels ]
+(defn get-color [pixel]
+ (Color/HSBtoRGB (/ (double pixel) *max-iteration*) 0.5 0.75))
+
+(defn calculate-pixels []
(let [pixels (range 0 (* *width* *height*))]
- (pmap (fn [p]
+ (doall (pmap (fn [p]
(let [row (rem p *width*) col (int (/ p *height*))]
(get-color (process-pixel (/ row (double *width*)) (/ col (double *height*))))))
- pixels)))
+ pixels))))
-(defn get-color [pixel]
- (Color/HSBtoRGB (/ (double pixel) *max-iteration*) 0.5 0.75))
+(defn calculate-pixels-2 []
+ (let [n (* *width* *height*)
+ work (partition (/ n 16) (range 0 n))
+ result (pmap (fn [x]
+ (doall (map
+ (fn [p]
+ (let [row (rem p *width*) col (int (/ p *height*))]
+ (get-color (process-pixel (/ row (double *width*)) (/ col (double *height*))))))
+ x)))
+ work)]
+ (apply concat result)))
(defn simple-mandlebrot [w h]
(let [x (int-array (calculate-pixels))]
@@ -43,5 +55,5 @@
(let [frame (JFrame. "Fractals")]
(doto frame
(.add canvas)
- (.setSize 128 128)
+ (.setSize 512 512)
(.setVisible true))))
View
@@ -32,9 +32,9 @@
(/ (- c) b)
(let [disc (- (square b) (* 4 a c))]
(if (> disc 0)
- (let [discroot (Math/sqrt disc)]
- (min (/ (+ (- b) discroot) (* 2 a))
- (/ (- (- b) discroot) (* 2 a))))))))
+ (let [discroot (Math/sqrt disc)]
+ (min (/ (+ (- b) discroot) (* 2 a))
+ (/ (- (- b) discroot) (* 2 a))))))))
;; Ray tracing bits
(def eye (struct point 150 150 200))
@@ -56,9 +56,10 @@
(defn sphere-intersect [s pt ray]
(let [c (:centre s)
n (minroot (+ (square (:x ray)) (square (:y ray)) (square (:z ray)))
- (* 2 (+ (* (- (:x pt) (:x c)) (:x ray))
- (* (- (:y pt) (:y c)) (:y ray))
- (* (- (:z pt) (:z c)) (:z ray))))
+ (* 2 (+
+ (* (- (:x pt) (:x c)) (:x ray))
+ (* (- (:y pt) (:y c)) (:y ray))
+ (* (- (:z pt) (:z c)) (:z ray))))
(+ (square (- (:x pt) (:x c)))
(square (- (:y pt) (:y c)))
(square (- (:z pt) (:z c)))
@@ -71,8 +72,8 @@
(defn lambert [s intersection ray]
(let [normal (sphere-normal s intersection)]
(max 0 (+ (* (:x ray) (:x normal))
- (* (:y ray) (:y normal))
- (* (:z ray) (:z normal))))))
+ (* (:y ray) (:y normal))
+ (* (:z ray) (:z normal))))))
;; second item = what we hit
;; first item = where we hit

0 comments on commit bf2e045

Please sign in to comment.