[Shootout-list] dispatch

Jon Harrop jon at ffconsultancy.com
Fri Jul 29 18:24:49 UTC 2005


On Friday 29 July 2005 06:14, Jon Harrop wrote:
> I've just written a few OCaml implementations of the dispatch test.

Here's an even shorter and faster implementation which specialises code using 
higher-order functions instead of inheritance. This is better than the OO 
approach because the interfaces are more explicit.

let b_next = function `Empty -> `Full | `Full -> `Sealed | `Sealed -> `Empty
let b_tag = function `Empty -> 1 | `Full -> 2 | `Sealed -> 3

let p_next = function
    `Empty -> `Full | `Full -> `Unsealed
  | `Unsealed -> `Sealed | `Sealed -> `Empty
let p_tag = function `Empty -> 4 | `Full -> 5 | `Unsealed -> 6 | `Sealed -> 7

type 'a bottle = { state: 'a; id: int }
let empty next b = { b with state = next b.state }
let fill = empty and seal = empty
let make id = { state = `Empty; id = id }

let check tag b c = tag b.state + b.id + c
let b_check = check b_tag and p_check = check p_tag

let b_cycle b = empty b_next (seal b_next (fill b_next b))
let p_cycle b =
  let pressurize b = { b with state = p_next b.state } in
  empty p_next (seal p_next (pressurize (fill p_next b)))

let bottle_check check cycle b1 b2 b3 b4 b5 i =
  let c = i mod 2 in
  check (cycle b1) c + check (cycle b2) c + check (cycle b3) c +
    check (cycle b4) c + check (cycle b5) c

let () =
  let [b0;b1;b2;b3;b4;b5;b6;b7;b8;b9] = List.map make [0;1;2;3;4;5;6;7;8;9] in
  let [p0;p1;p2;p3;p4;p5;p6;p7;p8;p9] = List.map make [0;1;2;3;4;5;6;7;8;9] in
  let c = ref 0 in
  for i=1 to int_of_string Sys.argv.(1) do
    c := !c + bottle_check b_check b_cycle b1 b2 b3 b4 b5 i +
      bottle_check b_check b_cycle b6 b7 b8 b9 b0 i +
      bottle_check p_check p_cycle p1 p2 p3 p4 p5 i -
      bottle_check p_check p_cycle p6 p7 p8 p9 p0 i;
  done;
  print_endline (string_of_int !c)

-- 
Dr Jon D Harrop, Flying Frog Consultancy Ltd.
Objective CAML for Scientists
http://www.ffconsultancy.com/products/ocaml_for_scientists



More information about the Shootout-list mailing list