/mobile Handheld Friendly website

 performance measurements

Each table row shows performance measurements for this OCaml program with a particular command-line input value N.

 N  CPU secs Elapsed secs Memory KB Code B ≈ CPU Load
60,0005.183.132,0161279  21% 55% 55% 19%
600,00053.2532.072,0201279  38% 38% 38% 37%
6,000,000551.05330.862,0281279  33% 44% 43% 32%

Read the ↓ make, command line, and program output logs to see how this program was run.

Read chameneos-redux benchmark to see what this program should do.

 notes

The OCaml native-code compiler, version 4.01.0

 chameneos-redux OCaml program source code

(* The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/

   contributed by Milan Stanojevic, Jul 12 2009
*)

module List = ListLabels
module String = StringLabels

open Printf

module Color = struct 
  type t =
  | Blue
  | Red
  | Yellow

  let complement t t' =
  match t, t' with 
    | Blue, Blue -> Blue
    | Blue, Red -> Yellow
    | Blue, Yellow -> Red
    | Red, Blue -> Yellow
    | Red, Red -> Red
    | Red, Yellow -> Blue
    | Yellow, Blue -> Red
    | Yellow, Red -> Blue
    | Yellow, Yellow -> Yellow

  let to_string = function
    | Blue -> "blue"
    | Red -> "red"
    | Yellow -> "yellow"

  let all = [ Blue; Red; Yellow ]
end

module Meeting_place = struct

  type 'chameneos t = {
    mutable state : [ `Empty | `First of 'chameneos | `Second of 'chameneos ];
    mutable meetings_left : int;
    mutex : Mutex.t;
    wait_for_second : Condition.t;
    wait_for_empty : Condition.t;
  }

  let create n = {
    state = `Empty;
    meetings_left = n;
    mutex = Mutex.create ();
    wait_for_second = Condition.create ();
    wait_for_empty = Condition.create ();
  }

  let meet t c = 
    let rec loop () = 
      if t.meetings_left = 0 then begin
        Condition.broadcast t.wait_for_empty;
        None
      end
      else
	match t.state with 
	| `Empty -> 
	    t.state <- `First c;
	    Condition.wait t.wait_for_second t.mutex;
	    begin
	      match t.state with 
	      | `Empty
	      | `First _ -> 
		  assert false
	      | `Second c -> 
		  t.state <- `Empty;
                  Condition.signal t.wait_for_empty;
                  Condition.signal t.wait_for_empty;
		  Some c
	    end
	| `First c1 ->
	    t.state <- `Second c;
	    t.meetings_left <- t.meetings_left - 1;
	    Condition.signal t.wait_for_second;
	    Some c1
	| `Second _ ->
	    Condition.wait t.wait_for_empty t.mutex;
	    loop ()
    in
    Mutex.lock t.mutex;
    let res = loop () in
    Mutex.unlock t.mutex;
    res
  ;;
end

module Chameneos = struct 
  
  type t = {
    id : int;
    mutable color : Color.t;
    mutable meetings : int;
    mutable meetings_with_self : int;
  }

  let create = 
    let id = ref 0 in
    let new_id () = 
      let r = !id in
      id := r + 1;
      r
    in
    fun color -> 
      { id = new_id ();
	color = color;
	meetings = 0;
	meetings_with_self = 0;
      }

  let run t place =
    let rec loop () =
      match Meeting_place.meet place t with 
      | None -> ()
      | Some other -> 
	  t.meetings <- t.meetings + 1;
	  if t.id = other.id then t.meetings_with_self <- t.meetings_with_self + 1;
	  t.color <- Color.complement t.color other.color;
	  loop () 
    in
    Thread.create loop ()
end

let print_complements () = 
  List.iter Color.all ~f:(fun c1 -> 
    List.iter Color.all ~f:(fun c2 ->
      printf "%s + %s -> %s\n" 
	(Color.to_string c1)
	(Color.to_string c2)
	(Color.to_string (Color.complement c1 c2))));
  printf "\n";
;;

let spell_int i = 
  let spell_char = function 
    | '0' -> "zero"
    | '1' -> "one"
    | '2' -> "two"
    | '3' -> "three"
    | '4' -> "four"
    | '5' -> "five"
    | '6' -> "six"
    | '7' -> "seven"
    | '8' -> "eight"
    | '9' -> "nine"
    | x -> failwith "unexpected char"
  in
  let s = string_of_int i in
  String.iter s ~f:(fun c -> printf " %s" (spell_char c));
;;
  
let work colors n = 
  let module C = Chameneos in
  List.iter colors ~f:(fun c -> printf " %s" (Color.to_string c)); printf "\n";
  let place = Meeting_place.create n in
  let cs = List.map colors ~f:Chameneos.create in
  let threads = List.map cs ~f:(fun c -> Chameneos.run c place) in
  List.iter threads ~f:Thread.join;
  let sum_meets = ref 0 in
  List.iter cs ~f:(fun c ->
    printf "%d" c.C.meetings; spell_int c.C.meetings_with_self; printf "\n";
    sum_meets := !sum_meets + c.C.meetings);
  spell_int !sum_meets; printf "\n";
;;


let main () = 
  let n = 
    try 
      int_of_string (Sys.argv.(1))
    with
    | _ -> 600
  in
  print_complements ();
  let module C = Color in
  work [ C.Blue; C.Red; C.Yellow ] n;
  printf "\n";
  work [ C.Blue; C.Red; C.Yellow; C.Red; C.Yellow; C.Blue; C.Red; C.Yellow; C.Red; C.Blue ] n;
  printf "\n";
;;

let () = main ()

 make, command-line, and program output logs

Thu, 12 Sep 2013 18:33:45 GMT

MAKE:
mv chameneosredux.ocaml chameneosredux.ml
/usr/local/bin/ocamlopt -noassert -unsafe -nodynlink -inline 100 -thread unix.cmxa threads.cmxa chameneosredux.ml -o chameneosredux.ocaml_run
rm chameneosredux.ml
0.36s to complete and log all make actions

COMMAND LINE:
./chameneosredux.ocaml_run 6000000

PROGRAM OUTPUT:
blue + blue -> blue
blue + red -> yellow
blue + yellow -> red
red + blue -> yellow
red + red -> red
red + yellow -> blue
yellow + blue -> red
yellow + red -> blue
yellow + yellow -> yellow

 blue red yellow
4000999 zero
3970442 zero
4028559 zero
 one two zero zero zero zero zero zero

 blue red yellow red yellow blue red yellow red blue
1184574 zero
1179639 zero
1175962 zero
1224872 zero
1178972 zero
1203406 zero
1194508 zero
1227010 zero
1227882 zero
1203175 zero
 one two zero zero zero zero zero zero

Revised BSD license

  Home   Conclusions   License   Play