From: William James <w_a_x_man@...>
Date: 2006-08-04T09:30:05+09:00
Subject: Re: For performance, write it in OCaml

Jon Harrop wrote:

> Here's my latest OCaml (I think we could revert to the simpler list-based
> permuter because no significant time is spent generating the permutations):
>
> let rec fact n = if n=0 then 1 else n*fact(n-1)
>
> let size = 5
>
> (* Permutation generator *)
> let p = Array.make size 0
> let xx = Array.init size (fun i -> if i<size-1 then 0 else -1)
> let gen_perm() =
>   let i = ref (size - 1) in
>   while !i > 0 && xx.(!i) = !i do
>     xx.(!i) <- 0;
>     decr i
>   done;
>   if !i = 0 then 1 else begin
>       xx.(!i) <- xx.(!i) + 1;
>       p.(0) <- 1;
>       for i=0 to size - 1 do
>         p.(i) <- p.(i - xx.(i));
>         p.(i - xx.(i)) <- i+1
>       done;
>       0
>     end
>
> let n = fact size
>
> (* Permutations *)
> let perms = Array.init n (fun _ -> ignore(gen_perm()); Array.copy p)
>
> let incompat =
>   let rec aux (px : int array) py i =
>     i<size && (px.(i) = py.(i) || aux px py (i+1)) in
>   Array.init n (fun x -> Array.init n (fun y -> aux perms.(x) perms.(y) 0))
>
> let join list = String.concat "" (Array.to_list (Array.map string_of_int
> list))
> let output_strings = Array.map join perms
> let board = Array.make size 0
>
> let op = String.make (size*(size+1)) ':'
>
> let rec add_a_row row =
>   if row=size then begin
>       for i=0 to size-1 do
>         String.blit output_strings.(board.(i)) 0 op (i*(size+1)) size
>       done;
>       print_string op
>     end else
>     for latest = 0 to n - 1 do
>       let prev_row = ref 0 in
>       let incompat = incompat.(latest) in
>       while !prev_row < row && not incompat.(board.(!prev_row)) do
>         incr prev_row;
>       done;
>       if !prev_row = row then begin
>           board.(row) <- latest;
>           add_a_row (row + 1)
>         end
>       done
>
> let () =
>   op.[size*(size+1)-1] <- '\n';
>   add_a_row 0

Here's a faster version of my program.

Eliminated a "not" in a loop by replacing the array of booleans
that shows incompatibility of two rows with an array that shows
compatibility.

Borrowed you idea of creating an output line ahead of time and
modifying it in place.

Timings:
1.11  yours
1.04  mine


(* compile with:
ocamlopt -unsafe -inline 100 latin-squares.ml -o latin-squares.exe
*)


(* permutation code by Eric C. Cooper *)
let rec distribute elt = function
  | (hd :: tl) as list -> (elt :: list) ::
      (List.map (fun x -> hd :: x) (distribute elt tl))
  | [] -> [ [elt] ]
let rec permute = function
  | x :: rest -> List.flatten (List.map (distribute x) (permute rest))
  | [] -> [ [] ] ;;

let list =  [ 1; 2; 3; 4; 5 ]
let size = List.length list

let perms = Array.of_list (permute list)
let n = Array.length perms

(* Used to determine if one row is compatible with another. *)
let compatible =  Array.make_matrix  n n  true ;;
for x = 0 to n - 1 do
  for y = 0 to n - 1 do
    compatible.(x).(y)  <-
      List.for_all2 ( <> )  perms.(x) perms.(y)
  done
done

let join list = String.concat "" (List.map string_of_int list)
let output_strings = Array.map join perms

(* For speed, create a string that's the length of the lines
   that we'll print; the :'s that aren't needed as separators
   will later be overwritten.  *)
let output_line = String.make (size*(size+1)-1) ':' ^ "\n"
let board =  Array.make size 0

let rec add_a_row row =
  if row = size then
    ( for i=0 to size-1 do
        String.blit
            output_strings.(board.(i)) 0 (* source *)
            output_line (i*(size+1))     (* dest *)
            size
      done;
      print_string output_line
    )
  else
    for latest = 0 to n - 1 do
      (* Create a changeable thing (variable). *)
      let prev_row = ref 0 in
      (* The ! below fetches the variable's value. *)
      while (!prev_row < row) &&
            (compatible.(latest).(board.(!prev_row))) do
        incr prev_row
      done;
      if !prev_row = row then
        ( board.(row) <- latest ; add_a_row (row + 1) )
    done
;;

add_a_row 0