[Shootout-list] OCaml programs
Christophe TROESTLER
del-con@tiscali.be
Tue, 15 Feb 2005 16:07:12 +0100 (CET)
----Next_Part(Tue_Feb_15_16_07_12_2005_551)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hi,
I sent some programs by through the mail interface (before finding the
way to subscribe to this list [1]) but do not see them in the archive.
So here they are again:
mandelbrot
nsieve (faster version)
pidigits (better code structure; marginally faster)
nbody
(my test machine is a P4 running Debian testing)
Cheers,
ChriS
---
[1] The link "Subscribe" on the page
http://shootout.alioth.debian.org/sandbox/miscfile.php?sort=cpu&file=mailinglist&title=mailing%20list
should point to http://lists.alioth.debian.org/mailman/listinfo/shootout-list
----Next_Part(Tue_Feb_15_16_07_12_2005_551)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="mandelbrot.ml"
(* http://shootout.alioth.debian.org/benchmark.php?test=mandelbrot&lang=all *)
(* Plot the Mandelbrot set [-1.5-i,0.5+i] on an N-by-N bitmap
(http://www-info2.informatik.uni-wuerzburg.de/mitarbeiter/wolfram/lehre/bildformate.html#pbm). *)
let niter = 50
let limit = 2.
let limit2 = limit *. limit
let add_bit0 cr ci byte =
let rec loop i zr zi =
if i > niter then (byte lsl 1) lor 0x01
else if zr *. zr +. zi *. zi > limit2 then (byte lsl 1) lor 0x00
else loop (succ i) (zr *. zr -. zi *. zi +. cr) (2. *. zr *. zi +. ci) in
loop 1 0. 0.
let () =
let w = int_of_string Sys.argv.(1) in
let h = w in
let invw = 2. /. float w
and invh = 2. /. float h
and cplmt8 = let w8 = w mod 8 in if w8 = 0 then 0 else 8 - w8 in
Printf.printf "P4\n%i %i\n" w h;
let byte = ref 0
and bit = ref 0 in
for y = 0 to h - 1 do
let ci = float y *. invh -. 1. in
for x = 0 to w - 2 do
byte := add_bit0 (float x *. invw -. 1.5) ci !byte;
incr bit;
if !bit = 8 then (
output_byte stdout !byte;
byte := 0;
bit := 0;
)
done;
output_byte stdout (!byte lsl cplmt8);
byte := 0;
bit := 0;
done
----Next_Part(Tue_Feb_15_16_07_12_2005_551)--
Content-Type: Text/Plain; charset=iso-8859-1
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline; filename="nsieve.ml"
(* http://shootout.alioth.debian.org/benchmark.php?test=3Dnsieve&lang=3D=
all *)
(* nsieve.ml -- na=EFve Sieve of Eratosthenes *)
module Bit =3D
struct
let get a i =3D
Char.code(a.[i lsr 3]) land (1 lsl (i land 7)) > 0
let set_false a i =3D
let ic =3D i lsr 3 in
a.[ic] <- Char.chr(Char.code(a.[ic]) land lnot(1 lsl (i land 7)))
let nsieve m =3D
let a =3D String.make ((m lsr 3)+1) '\255' (* Fill with 1-bits *) i=
n
let count =3D ref 0 in
for i =3D 2 to m - 1 do
if get a i then (
let j =3D ref(2*i) in
while !j < m do set_false a !j; j :=3D !j + i done;
incr count
)
done;
!count
end
let test n =3D
let m =3D (1 lsl n) * 10000 in
Printf.printf "Primes up to %8i %8i\n" m (Bit.nsieve m)
let () =3D
let n =3D int_of_string Sys.argv.(1) in
test n;
if n >=3D 1 then test(n-1);
if n >=3D 2 then test(n-2)
----Next_Part(Tue_Feb_15_16_07_12_2005_551)--
Content-Type: Text/Plain; charset=iso-8859-1
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline; filename="pidigits.ml"
(* Pi digits computed with the sreaming algorithm given on pages 4, 6
& 7 of "Unbounded Spigot Algorithms for the Digits of Pi", Jeremy
Gibbons, August 2004. *)
open Printf
open Big_int
let ( !$ ) =3D Big_int.big_int_of_int
let ( +$ ) =3D Big_int.add_big_int
let ( *$ ) =3D Big_int.mult_big_int
let ( =3D$ ) =3D Big_int.eq_big_int
let zero =3D Big_int.zero_big_int
and one =3D Big_int.unit_big_int
and three =3D !$ 3
and four =3D !$ 4
and ten =3D !$ 10
and neg_ten =3D !$(-10)
(* Linear Fractional (aka M=F6bius) Transformations *)
module LFT =3D
struct
let floor_ev (q,r,s,t) x =3D div_big_int (q *$ x +$ r) (s *$ x +$ t)
let unit =3D (one, zero, zero, one)
let comp (q,r,s,t) (q',r',s',t') =3D
(q *$ q' +$ r *$ s', q *$ r' +$ r *$ t',
s *$ q' +$ t *$ s', s *$ r' +$ t *$ t')
end
let next z =3D LFT.floor_ev z three
and safe z n =3D (n =3D$ LFT.floor_ev z four)
and prod z n =3D LFT.comp (ten, neg_ten *$ n, zero, one) z
and cons z k =3D
let den =3D 2*k+1 in LFT.comp z (!$ k, !$(2*den), zero, !$ den)
let rec digit k z n row col =3D
if n > 0 then
let y =3D next z in
if safe z y then
if col =3D 10 then (
let row =3D row + 10 in
printf "\t:%i\n%s" row (string_of_big_int y);
digit k (prod z y) (n-1) row 1
)
else (
print_string(string_of_big_int y);
digit k (prod z y) (n-1) row (col+1)
)
else digit (k+1) (cons z k) n row col
else
printf "%*s\t:%i\n" (10 - col) "" (row + col)
let digits n =3D digit 1 LFT.unit n 0 0
let () =3D
digits(int_of_string Sys.argv.(1))
----Next_Part(Tue_Feb_15_16_07_12_2005_551)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="nbody.ml"
(*
http://shootout.alioth.debian.org/benchmark.php?test=nbody&lang=all&sort=cpu
*)
let pi = 3.141592653589793
let solar_mass = 4. *. pi *. pi
let days_per_year = 365.24
type planet = {
mutable x : float; mutable y : float; mutable z : float;
mutable vx: float; mutable vy: float; mutable vz: float;
mass : float;
}
let advance bodies dt =
let n = Array.length bodies - 1 in
for i = 0 to n do
let b = bodies.(i) in
for j = i+1 to n do
let b' = bodies.(j) in
let dx = b.x -. b'.x and dy = b.y -. b'.y and dz = b.z -. b'.z in
let distance = sqrt(dx *. dx +. dy *. dy +. dz *. dz) in
let mag = dt /. (distance *. distance *. distance) in
b.vx <- b.vx -. dx *. b'.mass *. mag;
b.vy <- b.vy -. dy *. b'.mass *. mag;
b.vz <- b.vz -. dz *. b'.mass *. mag;
b'.vx <- b'.vx +. dx *. b.mass *. mag;
b'.vy <- b'.vy +. dy *. b.mass *. mag;
b'.vz <- b'.vz +. dz *. b.mass *. mag;
done
done;
for i = 0 to n do
let b = bodies.(i) in
b.x <- b.x +. dt *. b.vx;
b.y <- b.y +. dt *. b.vy;
b.z <- b.z +. dt *. b.vz;
done
let energy bodies =
let e = ref 0. in
for i = 0 to Array.length bodies - 1 do
let b = bodies.(i) in
e := !e +. 0.5 *. b.mass *. (b.vx *. b.vx +. b.vy *. b.vy +. b.vz *. b.vz);
for j = i+1 to Array.length bodies - 1 do
let b' = bodies.(j) in
let dx = b.x -. b'.x and dy = b.y -. b'.y and dz = b.z -. b'.z in
let distance = sqrt(dx *. dx +. dy *. dy +. dz *. dz) in
e := !e -. (b.mass *. b'.mass) /. distance
done
done;
!e
let offset_momentum bodies =
let px = ref 0. and py = ref 0. and pz = ref 0. in
for i = 0 to Array.length bodies - 1 do
px := !px +. bodies.(i).vx *. bodies.(i).mass;
py := !py +. bodies.(i).vy *. bodies.(i).mass;
pz := !pz +. bodies.(i).vz *. bodies.(i).mass;
done;
bodies.(0).vx <- -. !px /. solar_mass;
bodies.(0).vy <- -. !py /. solar_mass;
bodies.(0).vz <- -. !pz /. solar_mass
let jupiter = {
x = 4.84143144246472090e+00;
y = -1.16032004402742839e+00;
z = -1.03622044471123109e-01;
vx = 1.66007664274403694e-03 *. days_per_year;
vy = 7.69901118419740425e-03 *. days_per_year;
vz = -6.90460016972063023e-05 *. days_per_year;
mass = 9.54791938424326609e-04 *. solar_mass;
}
let saturn = {
x = 8.34336671824457987e+00;
y = 4.12479856412430479e+00;
z = -4.03523417114321381e-01;
vx = -2.76742510726862411e-03 *. days_per_year;
vy = 4.99852801234917238e-03 *. days_per_year;
vz = 2.30417297573763929e-05 *. days_per_year;
mass = 2.85885980666130812e-04 *. solar_mass;
}
let uranus = {
x = 1.28943695621391310e+01;
y = -1.51111514016986312e+01;
z = -2.23307578892655734e-01;
vx = 2.96460137564761618e-03 *. days_per_year;
vy = 2.37847173959480950e-03 *. days_per_year;
vz = -2.96589568540237556e-05 *. days_per_year;
mass = 4.36624404335156298e-05 *. solar_mass;
}
let neptune = {
x = 1.53796971148509165e+01;
y = -2.59193146099879641e+01;
z = 1.79258772950371181e-01;
vx = 2.68067772490389322e-03 *. days_per_year;
vy = 1.62824170038242295e-03 *. days_per_year;
vz = -9.51592254519715870e-05 *. days_per_year;
mass = 5.15138902046611451e-05 *. solar_mass;
}
let sun = {
x = 0.; y = 0.; z = 0.; vx = 0.; vy = 0.; vz = 0.;
mass= solar_mass;
}
let bodies = [| sun; jupiter; saturn; uranus; neptune |]
let () =
let n = int_of_string(Sys.argv.(1)) in
offset_momentum bodies;
Printf.printf "%.9f\n" (energy bodies);
for i = 1 to n do
advance bodies 0.01
done;
Printf.printf "%.9f\n" (energy bodies)
----Next_Part(Tue_Feb_15_16_07_12_2005_551)----