William said:
I stole code and ideas from Jon Harrop, so this should be called
the James/Harrop version.
I just noticed that your site doesn't have my last version (the 4th).
Here it is again:
(* Thanks to Jon Harrup for code and ideas. *)
(* 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
(* Boolean array used to determine if one row is
compatible with another. *)
let compatible = Array.make_matrix n n true ;;
Array.iteri (fun x ex ->
Array.iteri (fun y ey ->
compatible.(x).(y) <- List.for_all2 (<>) ex ey) perms ) perms
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
(* A recursive function. *)
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
let compatible_slice = compatible.(latest) in
(* Create a changeable thing (variable). *)
let prev_row = ref 0 in
(* The ! below fetches the variable's value. *)
while !prev_row < row &&
compatible_slice.(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
