All Source For ocaml |
Ackermann's Function |
(*
* $Id: ackermann.ocaml,v 1.9 2001/01/08 02:56:48 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let rec ack m n =
if m = 0 then n + 1
else if n = 0 then ack (m - 1) 1
else ack (m - 1) (ack m (n - 1))
let _ =
let arg =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
Printf.printf "Ack(3,%d): %d\n" arg (ack 3 arg)
|
Array Access |
(*
* $Id: ary3.ocaml,v 1.1 2001/05/31 02:27:48 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let last = n-1
and x = Array.make n 0
and y = Array.make n 0 in
for i = 0 to last do
x.(i) <- (i + 1)
done;
for k = 0 to 999 do
for i = last downto 0 do
y.(i) <- (x.(i) + y.(i))
done
done;
Printf.printf "%d %d\n" y.(0) y.(last)
|
Count Lines/Words/Chars |
(*
* $Id: wc.ocaml,v 1.7 2001/05/25 22:33:22 doug Exp $
* http://www.bagley.org/~doug/shootout/
* based on code by Cuihtlauac ALVARADO and Markus Mottl
*)
let nl = ref 0
let nw = ref 0
let nc = ref 0
let max = 4096
let buf = String.create max
let readblock scanfun =
let nread = input stdin buf 0 max in
if nread = 0 then () else
begin nc := !nc + nread; scanfun 0 nread end
let rec scan_out_of_word i n =
if i < n then
match buf.[i] with
| '\n' -> incr nl; scan_out_of_word (i+1) n
| ' '|'\t' -> scan_out_of_word (i+1) n
| _ -> incr nw; scan_in_word (i+1) n
else
readblock scan_out_of_word
and scan_in_word i n =
if i < n then
match buf.[i] with
| '\n' -> incr nl; scan_out_of_word (i+1) n
| ' '|'\t' -> scan_out_of_word (i+1) n
| _ -> scan_in_word (i+1) n
else
readblock scan_in_word
let _ =
scan_out_of_word 0 0;
Printf.printf "%d %d %d\n" !nl !nw !nc
|
Echo Client/Server |
(*
* $Id: echo.ocaml,v 1.8 2001/05/13 17:13:06 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
open Unix
let data = "Hello there sailor\n"
let rec sock_write sock buf offset len =
if len > 0 then begin
let nwritten = write sock buf offset len in
sock_write sock buf (offset + nwritten) (len - nwritten)
end
let sock_readline buf sock =
let offset = ref (read sock buf 0 64) in
while String.get buf (!offset - 1) <> '\n' do
offset := !offset + (read sock buf !offset 64)
done;
!offset
let rec buf_ok buf n = n <= 0 || buf.[n] = data.[n] && buf_ok buf (n - 1)
let echo_client n port =
let sock = socket PF_INET SOCK_STREAM 0 in
connect sock (ADDR_INET (inet_addr_of_string "127.0.0.1", port));
let len = String.length data
and buf = String.create 64 in
for i = 1 to n do
sock_write sock data 0 len;
let ans_len = sock_readline buf sock in
if ans_len <> len || not (buf_ok buf (len - 1)) then begin
prerr_string "client got bad data: ";
prerr_endline (String.sub buf 0 ans_len);
exit 1
end
done;
close sock
let ssock =
let ssock = socket PF_INET SOCK_STREAM 0
and addr = inet_addr_of_string "127.0.0.1" in
bind ssock (ADDR_INET (addr, 0));
setsockopt ssock SO_REUSEADDR true;
listen ssock 2;
ssock
let get_port sock =
match getsockname sock with
| ADDR_INET (_, port) -> port
| ADDR_UNIX _ -> raise (Failure "getsockname")
let echo_server n =
let port = get_port ssock
and pid = fork() in
if pid <> 0 then begin
let csock, addr = accept ssock
and buf = String.create 64
and len = ref 0
and nread = ref 1 in
while !nread > 0 do
nread := read csock buf 0 64;
sock_write csock buf 0 !nread;
len := !len + !nread
done;
ignore (wait ());
Printf.printf "server processed %d bytes\n" !len end
else
echo_client n port
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
echo_server n
|
Exception Mechanisms |
(*
* $Id: except.ocaml,v 1.6 2001/07/28 21:52:57 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
* and Mark Baker
*)
exception HiException of int
exception LoException of int
let hi = ref 0
let lo = ref 0
let blowup n =
if n mod 2 = 0 then raise (LoException n)
else raise (HiException n)
let lo_fun n = try blowup n with LoException _ -> incr lo
let hi_fun n = try lo_fun n with HiException _ -> incr hi
let some_fun n =
try hi_fun n with exc -> print_endline "Should not get here."; raise exc
let _ =
let n = if Array.length Sys.argv > 1 then int_of_string Sys.argv.(1) else 1 in
for i = 1 to n do some_fun i done;
Printf.printf "Exceptions: HI=%d / LO=%d\n" !hi !lo
|
Fibonacci Numbers |
(*
* $Id: fibo.ocaml,v 1.3 2001/01/08 03:01:50 doug Exp $
* http://www.bagley.org/~doug/shootout/
*)
let rec fib n =
if n < 2 then 1
else fib (n - 2) + fib (n - 1)
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
Printf.printf "%d\n" (fib n)
|
Hash (Associative Array) Access |
(*
* $Id: hash.ocaml,v 1.4 2001/01/08 03:02:47 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let hexdigits = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
'8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f'; |]
let buf = String.create 32
let rec hexstring_of_int n idx len =
if n <= 0 then String.sub buf idx len
else begin
let new_idx = idx - 1
and new_len = len + 1 in
String.set buf new_idx hexdigits.(n land 15);
hexstring_of_int (n lsr 4) new_idx new_len
end
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let hx = Hashtbl.create n in
for i = 1 to n do
Hashtbl.add hx (hexstring_of_int i 32 0) true
done;
let c = ref 0 in
for i = n downto 1 do
if Hashtbl.mem hx (string_of_int i) then incr c
done;
Printf.printf "%d\n" !c
|
Hashes, Part II |
(*
* $Id: hash2.ocaml,v 1.3 2001/01/08 13:21:09 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1
and hash1 = Hashtbl.create 10000 in
for i = 0 to 9999 do
Hashtbl.add hash1 ("foo_" ^ string_of_int i) (ref i)
done;
let hash2 = Hashtbl.create 10000 in
let update_hash2 k v =
try
let valref = Hashtbl.find hash2 k in
valref := !valref + !v
with Not_found -> Hashtbl.add hash2 k (ref !v) in
for i = 1 to n do
Hashtbl.iter update_hash2 hash1
done;
Printf.printf "%d %d %d %d\n"
!(Hashtbl.find hash1 "foo_1")
!(Hashtbl.find hash1 "foo_9999")
!(Hashtbl.find hash2 "foo_1")
!(Hashtbl.find hash2 "foo_9999")
|
Heapsort |
(*
* $Id: heapsort.ocaml,v 1.9 2001/05/08 02:46:59 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let im = 139968
let ia = 3877
let ic = 29573
let last = ref 42
let gen_random max =
last := (!last * ia + ic) mod im;
max *. float_of_int !last /. float_of_int im
let heapsort n ra =
let l = ref ((n lsr 1) + 1)
and rra = ref 0.0
and i = ref 0
and j = ref 0
and ir = ref n in
try
while true do
if !l > 1 then begin
decr l;
rra := ra.(!l)
end
else begin
rra := ra.(!ir);
ra.(!ir) <- ra.(1);
decr ir;
if !ir = 1 then begin
ra.(1) <- !rra;
raise Exit
end
end;
i := !l;
j := !l lsl 1;
while !j <= !ir do
if !j < !ir && ra.(!j) < ra.(!j+1) then incr j;
if !rra < ra.(!j) then begin
ra.(!i) <- ra.(!j);
i := !j;
j := !j + !i
end
else j := !ir + 1;
done;
ra.(!i) <- !rra;
done
with Exit -> ()
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let ary = Array.make (n + 1) 0.0 in
for i = 1 to n do
ary.(i) <- gen_random 1.0
done;
heapsort n ary;
Printf.printf "%.10f\n" ary.(n)
|
Hello World |
(*
* $Id: hello.ocaml,v 1.1 2001/06/17 22:00:34 doug Exp $
* http://www.bagley.org/~doug/shootout/
*)
let _ = print_endline "hello world"
|
List Operations |
(*
* $Id: lists.ocaml,v 1.9 2001/01/31 02:12:48 doug Exp $
* http://www.bagley.org/~doug/shootout/
* from Benedict Rosenau
*)
module Deque:
sig
type 'a t
exception Empty
val make: int -> 'a -> 'a t
val iota: int -> int t
val is_empty: 'a t -> bool
val equal: 'a t -> 'a t -> bool
val length: 'a t -> int
val nth: 'a t -> int -> 'a
val push_front: 'a -> 'a t -> unit
val push_back: 'a t -> 'a -> unit
val take_front: 'a t -> 'a
val take_back: 'a t -> 'a
val copy: 'a t -> 'a t
val reverse: 'a t -> 'a t
end =
struct
type 'a t = {mutable size: int;
mutable first: int;
mutable last: int;
mutable field: 'a array;
fill: 'a}
exception Empty
let make n dummy =
let n = max n 0 in
let nplus = max 1 n in
{size = nplus;
first = nplus lsr 1;
last = (nplus lsr 1) - 1;
field = Array.make nplus dummy;
fill = dummy}
let iota i =
let i = max 0 i in
let iplus = max 1 i in
{size = iplus;
first = 0;
last = i - 1;
field = Array.init iplus (fun n -> n + 1);
fill = i}
let length buf = buf.last - buf.first + 1
let is_empty buf = buf.last < buf.first
let rec array_eq arr1 off1 arr2 off2 = function
| 0 -> true
| n ->
if arr1.(off1) <> arr2.(off2) then false
else array_eq arr1 (off1 + 1) arr2 (off2 + 1) (n - 1)
let equal buf1 buf2 =
let len = length buf1 in
if len <> length buf2 then false
else array_eq buf1.field buf1.first buf2.field buf2.first len
let nth buf n =
if n < 0 or n >= length buf then failwith "nth";
buf.field.(buf.first + n)
let double_shift buf =
let new_size = buf.size lsl 1
and len = length buf in
let new_first = (new_size - len) lsr 1
and new_field = Array.make new_size buf.fill in
Array.blit buf.field buf.first new_field new_first len;
buf.size <- new_size;
buf.field <- new_field;
buf.first <- new_first;
buf.last <- new_first + len - 1
let push_front elem buf =
if buf.first = 0 then double_shift buf;
let new_first = buf.first - 1 in
buf.field.(new_first) <- elem;
buf.first <- new_first
let push_back buf elem =
if buf.last = buf.size - 1 then double_shift buf;
let new_last = buf.last + 1 in
buf.field.(new_last) <- elem;
buf.last <- new_last
let take_front buf =
if is_empty buf then raise Empty;
let old_first = buf.first in
buf.first <- old_first + 1;
buf.field.(old_first)
let take_back buf =
if is_empty buf then raise Empty;
let old_last = buf.last in
buf.last <- old_last - 1;
buf.field.(old_last)
let copy buf =
let len = length buf in
let new_buf = make len buf.fill in
Array.blit buf.field buf.first new_buf.field 0 len;
new_buf.first <- 0;
new_buf.last <- len - 1;
new_buf
let reverse buf =
let len = length buf
and fst = buf.first
and fld = buf.field in
let new_buf = make len buf.fill in
let new_fld = new_buf.field in
for i = 0 to len - 1 do
new_fld.(len - i - 1) <- fld.(fst + i)
done;
new_buf.first <- 0;
new_buf.last <- len - 1;
new_buf
end
open Deque
let empty () = iota 0
let size = 10000
let test_lists () =
let d1 = iota size in
let d2 = copy d1
and d3 = empty () in
for i = 1 to length d2 do
push_back d3 (take_front d2)
done;
for i = 1 to length d3 do
push_back d2 (take_back d3)
done;
let d1 = reverse d1 in
if size <> nth d1 0 then failwith "First test failed";
if length d1 <> length d2 then failwith "Second test failed";
if not (equal d1 d2) then failwith "Third test failed";
length d1
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1
and result = ref 0 in
for i = 1 to n do
result := test_lists ()
done;
Printf.printf "%d\n" !result
|
Matrix Multiplication |
(*
* $Id: matrix.ocaml,v 1.7 2001/01/14 13:47:41 doug Exp $
* http://www.bagley.org/~doug/shootout/
* from Markus Mottl
*)
let size = 30
let mkmatrix rows cols =
let count = ref 1
and last_col = cols - 1
and m = Array.make_matrix rows cols 0 in
for i = 0 to rows - 1 do
let mi = m.(i) in
for j = 0 to last_col do
mi.(j) <- !count;
incr count
done;
done;
m
let rec inner_loop k v m1i m2 j =
if k < 0 then v
else inner_loop (k - 1) (v + m1i.(k) * m2.(k).(j)) m1i m2 j
let mmult rows cols m1 m2 m3 =
let last_col = cols - 1
and last_row = rows - 1 in
for i = 0 to last_row do
let m1i = m1.(i) and m3i = m3.(i) in
for j = 0 to last_col do
m3i.(j) <- inner_loop last_row 0 m1i m2 j
done;
done
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1
and m1 = mkmatrix size size
and m2 = mkmatrix size size
and m3 = Array.make_matrix size size 0 in
for i = 1 to n - 1 do
mmult size size m1 m2 m3
done;
mmult size size m1 m2 m3;
Printf.printf "%d %d %d %d\n" m3.(0).(0) m3.(2).(3) m3.(3).(2) m3.(4).(4)
|
Method Calls |
(*
* $Id: methcall.ocaml,v 1.6 2001/01/08 03:08:35 doug Exp $
* http://www.bagley.org/~doug/shootout/
* from: Benedikt Rosenau
* with contributions from Markus Mottl
*)
let print_bool b = print_endline (string_of_bool b)
class toggle start_state = object (self)
val mutable state = start_state
method value = state
method activate = state <- not state; self
end
class nth_toggle start_state max_counter = object (self)
inherit toggle start_state
val count_max = max_counter
val mutable counter = 0
method activate =
counter <- counter + 1;
if counter >= count_max
then begin
state <- not state;
counter <- 0
end;
self
end
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let tog = new toggle true in
for i = 2 to n do
ignore tog#activate#value
done;
print_bool tog#activate#value;
let ntog = new nth_toggle true 3 in
for i = 2 to n do
ignore ntog#activate#value
done;
print_bool ntog#activate#value
|
Nested Loops |
(*
* $Id: nestedloop.ocaml,v 1.7 2001/06/27 11:37:53 doug Exp $
* http://www.bagley.org/~doug/shootout/
* based on code from Florian Hars and Markus Mottl
*)
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let rec loopF x = function 0 -> x | i -> loopF (x+1) (i-1) in
let rec loopE x = function 0 -> x | i -> loopE (loopF x n) (i-1) in
let rec loopD x = function 0 -> x | i -> loopD (loopE x n) (i-1) in
let rec loopC x = function 0 -> x | i -> loopC (loopD x n) (i-1) in
let rec loopB x = function 0 -> x | i -> loopB (loopC x n) (i-1) in
let rec loopA x = function 0 -> x | i -> loopA (loopB x n) (i-1) in
Printf.printf "%d\n" (loopA 0 n)
|
Object Instantiation |
(*
* $Id: objinst.ocaml,v 1.8 2001/07/28 21:52:59 doug Exp $
* http://www.bagley.org/~doug/shootout/
* from: Benedikt Rosenau
* with contributions from Markus Mottl
*)
class toggle start_state = object (self)
val mutable state = start_state
method value = state
method activate = state <- not state; self
end
class nth_toggle start_state max_counter = object (self)
inherit toggle start_state
val count_max = max_counter
val mutable counter = 0
method activate =
counter <- counter + 1;
if counter >= count_max then begin
state <- not state;
counter <- 0
end;
self
end
let n = if Array.length Sys.argv > 1 then int_of_string Sys.argv.(1) else 1
let tog = new toggle true;;
for i = 1 to 5 do Printf.printf "%b\n" tog#activate#value done;
for i = 1 to n do ignore (new toggle true) done;
print_newline ();
let ntog = new nth_toggle true 3 in
for i = 1 to 8 do Printf.printf "%b\n" ntog#activate#value done;
for i = 1 to n do ignore (new nth_toggle true 3) done
|
Producer/Consumer Threads |
(*
* $Id: prodcons.ocaml,v 1.6 2001/07/28 21:52:59 doug Exp $
* http://www.bagley.org/~doug/shootout/
*
* ocamlopt -thread unix.cmxa threads.cmxa prodcons.ml -o prodcons
* or
* ocamlc -thread unix.cma threads.cma prodcons.ml -o prodcons
*)
let count = ref 0
let data = ref 0
let produced = ref 0
let consumed = ref 0
let m = Mutex.create ()
let c = Condition.create ()
let producer n =
for i = 1 to n do
Mutex.lock m;
while !count = 1 do Condition.wait c m done;
data := i;
incr count;
Condition.signal c;
Mutex.unlock m;
incr produced
done
let consumer n =
let i = ref 0 in
while !i <> n do
Mutex.lock m;
while !count = 0 do Condition.wait c m done;
i := !data;
decr count;
Condition.signal c;
Mutex.unlock m;
incr consumed
done
let n = if Array.length Sys.argv > 1 then int_of_string Sys.argv.(1) else 1
let p = Thread.create producer n and c = Thread.create consumer n;;
Thread.join p; Thread.join c;
Printf.printf "%d %d\n" !produced !consumed
|
Random Number Generator |
(*
* $Id: random.ocaml,v 1.10 2001/07/26 01:33:45 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let im = 139968
let ia = 3877
let ic = 29573
let last_ref = ref 42
let gen_random max =
let new_last = (!last_ref * ia + ic) mod im in
last_ref := new_last;
max *. float_of_int new_last /. float im
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let rec loop i =
let r = gen_random 100.0 in
if i > 1 then loop (i-1) else r in
Printf.printf "%.9f\n" (loop n)
|
Regular Expression Matching |
(*
* $Id: regexmatch.ocaml,v 1.4 2001/01/08 13:19:11 doug Exp $
* http://www.bagley.org/~doug/shootout/
* from: Markus Mottl
*)
open Pcre
let rex =
regexp ~flags:[`EXTENDED]
"(?: ^ | [^\d\(]) # must be preceeded by non-digit
(\(\d\d\d\)|\d\d\d) # match 1: area code
[ ] # area code followed by one space
\d\d\d # prefix of 3 digits
[ -] # separator is either space or dash
\d\d\d\d # last 4 digits
(?: \D|$) # must be followed by a non-digit (or EOL)"
let phones =
let lines = ref [] in
foreach_line (fun line -> lines := line :: !lines);
List.rev !lines
let check_phone irflags ar cnt must_print line =
try
unsafe_pcre_exec irflags rex 0 line 4 ar;
let num = String.copy "(...) ...-...." in
let pos = Array.unsafe_get ar 2 in
let ofs = if String.unsafe_get line pos = '(' then 1 else 0 in
let pos = pos + ofs in
String.unsafe_blit line pos num 1 3;
let pos = pos + ofs + 4 in
String.unsafe_blit line pos num 6 3;
String.unsafe_blit line (pos + 4) num 10 4;
if must_print then Printf.printf "%d: %s\n" !cnt num;
incr cnt
with Not_found -> ()
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
for i = 2 to n do
List.iter (check_phone (rflags []) (Array.create 6 0) (ref 1) false) phones
done;
List.iter (check_phone (rflags []) (Array.create 6 0) (ref 1) true) phones
|
Reverse a File |
(*
* $Id: reversefile.ocaml,v 1.11 2001/01/27 13:59:47 doug Exp $
* http://www.bagley.org/~doug/shootout/
*)
let size = 10000
let rec lect stack buf pos free =
let nrd = input stdin buf pos free in
if nrd = 0 then stack,buf,pos
else if nrd = free then
lect (buf :: stack) (String.create size) 0 size
else lect stack buf (pos+nrd) (free-nrd)
let output_buf (buf,len) = output stdout buf 0 len
let rec rev_write tail stack buf len pos =
if pos = 0 then
match stack with
| [] -> output stdout buf 0 len; List.iter output_buf tail
| topbuf :: stack ->
let toplen = String.length topbuf in
rev_write ((buf,len) :: tail) stack topbuf toplen toplen
else if buf.[pos-1] = '\n' then
begin
output stdout buf pos (len-pos);
List.iter output_buf tail;
rev_write [] stack buf pos (pos-1)
end
else rev_write tail stack buf len (pos-1)
let main =
let stack,buf,length =
lect [] (String.create size) 0 size in
rev_write [] stack buf length length
|
Sieve of Erathostenes |
(*
* $Id: sieve.ocaml,v 1.10 2001/06/10 04:12:44 doug Exp $
* http://www.bagley.org/~doug/shootout/
* based on code from Markus Mottl
*)
let flags = String.make 8193 'f'
let rec inner_loop k i =
if k < 8193 then begin
flags.[k] <- 'f';
inner_loop (k + i) i
end
let rec middle_loop i cnt =
if i < 8193 then
if flags.[i] = 't' then begin
inner_loop (i + i) i;
middle_loop (i + 1) (cnt + 1) end
else middle_loop (i + 1) cnt
else cnt
let _ =
let num =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1
and cnt = ref 0 in
for iter = 1 to num do
for i = 2 to 8192 do flags.[i] <- 't' done;
cnt := middle_loop 2 0;
done;
Printf.printf "Count: %d\n" !cnt
|
Spell Checker |
(*
* $Id: spellcheck.ocaml,v 1.7 2001/07/28 21:52:59 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let dict = Hashtbl.create 40000 and ic = open_in "Usr.Dict.Words" in
try while true do Hashtbl.add dict (input_line ic) true done
with End_of_file -> close_in ic;
let rec loop () =
let word = input_line stdin in
if not (Hashtbl.mem dict word) then print_endline word;
loop () in
try loop () with End_of_file -> ()
|
Statistical Moments |
(*
* $Id: moments.ocaml,v 1.9 2001/05/20 16:43:13 doug Exp $
* http://www.bagley.org/~doug/shootout/
* with help from Markus Mottl
*)
let _ =
let n = ref 0
and num = ref 0.0
and sum = ref 0.0
and mean = ref 0.0
and average_deviation = ref 0.0
and standard_deviation = ref 0.0
and variance = ref 0.0
and skew = ref 0.0
and kurtosis = ref 0.0
and deviation = ref 0.0
and size = ref 4096 in
let nums_in = ref (Array.create !size 0.0) in
try
while true do
num := read_float ();
!nums_in.(!n) <- !num;
sum := !sum +. !num;
incr n;
if !n = !size then begin
nums_in := Array.append !nums_in (Array.create !size 0.0);
size := !size * 2
end
done
with End_of_file -> ();
let nums = Array.create !n 0.0 in
Array.blit !nums_in 0 nums 0 !n;
let n_float = float_of_int !n in
mean := !sum /. n_float;
for i = 0 to !n - 1 do
deviation := nums.(i) -. !mean;
average_deviation := !average_deviation +. abs_float !deviation;
let dev2 = !deviation *. !deviation in
variance := !variance +. dev2;
let dev3 = dev2 *. !deviation in
skew := !skew +. dev3;
let dev4 = dev3 *. !deviation in
kurtosis := !kurtosis +. dev4;
done;
average_deviation := !average_deviation /. n_float;
variance := !variance /. float_of_int (!n - 1);
standard_deviation := sqrt !variance;
if !variance > 0.0 then begin
skew := !skew /. n_float /. !variance /. !standard_deviation;
kurtosis := !kurtosis /. n_float /. !variance /. !variance -. 3.0;
end;
Array.stable_sort compare nums;
let mid = !n lsr 1 in
let median =
if !n mod 2 = 1 then nums.(mid)
else (nums.(mid) +. nums.(mid - 1)) /. 2.0 in
Printf.printf "n: %d\n" !n;
Printf.printf "median: %f\n" median;
Printf.printf "mean: %f\n" !mean;
Printf.printf "average_deviation: %f\n" !average_deviation;
Printf.printf "standard_deviation: %f\n" !standard_deviation;
Printf.printf "variance: %f\n" !variance;
Printf.printf "skew: %f\n" !skew;
Printf.printf "kurtosis: %f\n" !kurtosis
|
String Concatenation |
(*
* $Id: strcat.ocaml,v 1.6 2001/05/02 05:55:22 doug Exp $
* http://www.bagley.org/~doug/shootout/
* from: Benedikt Rosenau
*)
let _ =
let n =
try int_of_string Sys.argv.(1)
with Invalid_argument _ -> 1 in
let buf = Buffer.create 0 in
for i = 1 to n do
Buffer.add_string buf "hello\n"
done;
Printf.printf "%d\n" (Buffer.length buf);
|
Sum a Column of Integers |
(*
* $Id: sumcol.ocaml,v 1.6 2001/01/14 15:26:28 doug Exp $
* http://www.bagley.org/~doug/shootout/
* from Markus Mottl
*)
let sum = ref 0
let rec loop () = sum := !sum + read_int (); loop ()
let _ = try loop () with End_of_file -> Printf.printf "%d\n" !sum
|
Word Frequency Count |
(*
* $Id: wordfreq.ocaml,v 1.8 2001/05/26 01:48:48 doug Exp $
* http://www.bagley.org/~doug/shootout/
*)
let max = 4096
let buf = String.create max
let count = Hashtbl.create 75000
let wbuf = Buffer.create 64
let rec scan_words i n inword =
if i < n then
let c = buf.[i] in
if 'a' <= c && c <= 'z' then begin
Buffer.add_char wbuf c;
scan_words (i+1) n true
end
else if 'A' <= c && c <= 'Z' then begin
Buffer.add_char wbuf (Char.unsafe_chr(Char.code c + 32));
scan_words (i+1) n true
end
else if inword then begin
let word = Buffer.contents wbuf in
begin try incr (Hashtbl.find count word)
with Not_found -> Hashtbl.add count word (ref 1) end;
Buffer.clear wbuf;
scan_words (i+1) n false
end else
scan_words (i+1) n false
else
let nread = input stdin buf 0 max in
if nread = 0 then () else scan_words 0 nread inword
let _ =
scan_words 0 0 false;
let out_lines = ref [] in
let to_list l w c =
l := (Printf.sprintf "%7d\t%s" !c w) :: !l in
Hashtbl.iter (to_list out_lines) count;
List.iter print_endline (List.sort (fun a b -> compare b a) !out_lines)
|