On Saturday 23 June 2007 12:05:01 Claus Reinke wrote:
> >>>http://www.kantaka.co.uk/darcs/ray
> >>
> >>try making ray_sphere and intersect' local to intersect,
> >>then drop their constant ray parameter. saves me 25%.
> >>claus
>
> also try replacing that (foldl' intersect') with (foldr (flip intersect'))!
>
> using a recent ghc head instead of ghc-6.6.1 also seems to
> make a drastic difference (wild guess, seeing the unroll 1000
> for ocaml: has there been a change to default unrolling in ghc?).
Wow! Now I get:
GHC: 15.8s
OCaml: 14s
g++: 10s
That's very impressive, and more than I was expecting. I think it is worth
noting that you are now comparing optimized Haskell to unoptimized OCaml
though, so the OCaml has more "low-hanging optimization fruit". :-)
At this point, the single most productive optimization for the OCaml is to
evade the polymorphism and closure in the "intersect" function by inlining
the call to "List.fold_left". This makes the OCaml basically as fast as the
C++ on my machine:
GHC: 15.8s
OCaml: 10.6s
g++: 10s
let delta = sqrt epsilon_float
type vec = {x:float; y:float; z:float}
let zero = {x=0.; y=0.; z=0.}
let ( *| ) s r = {x = s *. r.x; y = s *. r.y; z = s *. r.z}
let ( +| ) a b = {x = a.x +. b.x; y = a.y +. b.y; z = a.z +. b.z}
let ( -| ) a b = {x = a.x -. b.x; y = a.y -. b.y; z = a.z -. b.z}
let dot a b = a.x *. b.x +. a.y *. b.y +. a.z *. b.z
let length r = sqrt(dot r r)
let unitise r = 1. /. length r *| r
let rec intersect orig dir (l, _ as hit) (center, radius, scene) =
let l' =
let v = center -| orig in
let b = dot v dir in
let disc = sqrt(b *. b -. dot v v +. radius *. radius) in
let t1 = b -. disc and t2 = b +. disc in
if t2>0. then if t1>0. then t1 else t2 else infinity in
if l' >= l then hit else match scene with
| [] -> l', unitise (orig +| l' *| dir -| center)
| scenes -> intersects orig dir hit scenes
and intersects orig dir hit = function
| [] -> hit
| scene::scenes -> intersects orig dir (intersect orig dir hit scene) scenes
let light = unitise {x=1.; y=3.; z= -2.} and ss = 4
let rec ray_trace dir scene =
let l, n = intersect zero dir (infinity, zero) scene in
let g = dot n light in
if g <= 0. then 0. else
let p = l *| dir +| sqrt epsilon_float *| n in
if fst (intersect p light (infinity, zero) scene) < infinity then 0. else
g
let rec create level c r =
let obj = c, r, [] in
if level = 1 then obj else
let a = 3. *. r /. sqrt 12. in
let aux x' z' = create (level - 1) (c +| {x=x'; y=a; z=z'}) (0.5 *. r) in
c, 3. *. r, [obj; aux (-.a) (-.a); aux a (-.a); aux (-.a) a; aux a a]
let level, n =
try int_of_string Sys.argv.(1), int_of_string Sys.argv.(2) with _ -> 6, 512
let scene = create level {x=0.; y= -1.; z=4.} 1.;;
Printf.printf "P5\n%d %d\n255\n" n n;;
for y = n - 1 downto 0 do
for x = 0 to n - 1 do
let g = ref 0. in
for dx = 0 to ss - 1 do
for dy = 0 to ss - 1 do
let aux x d = float x -. float n /. 2. +. float d /. float ss in
let dir = unitise {x=aux x dx; y=aux y dy; z=float n} in
g := !g +. ray_trace dir scene
done;
done;
let g = 0.5 +. 255. *. !g /. float (ss*ss) in
Printf.printf "%c" (char_of_int (int_of_float g))
done;
done
--
Dr Jon D Harrop, Flying Frog Consultancy Ltd.
The OCaml Journal
http://www.ffconsultancy.com/products/ocaml_journal/?e
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
