open Net_runtime;;
exception Found;;
let n_queens n =
let iterations = ref 0 in
let solution = Array.create n 0 in
let row_has_queen = Array.create n false in
let diag_has_queen = Array.create (2*n-1) false in
let rev_diag_has_queen = Array.create (2*n-1) false in
let rec set_queen col =
if col >= n then
raise Found
else
for row = 0 to n-1 do
incr iterations;
if not row_has_queen.(row) &
not diag_has_queen.(row + col) &
not rev_diag_has_queen.(row - col + n - 1) then begin
(* place the queen *)
solution.(col) <- row;
row_has_queen.(row) <- true;
diag_has_queen.(row + col) <- true;
rev_diag_has_queen.(row - col + n - 1) <- true;
set_queen (col+1);
(* failure: *)
row_has_queen.(row) <- false;
diag_has_queen.(row + col) <- false;
rev_diag_has_queen.(row - col + n - 1) <- false
end
done
in
try
set_queen 0;
raise Not_found
with
Found ->
!iterations, solution
;;
let n_queens_callback [| n_str |] =
try
let n = int_of_string n_str in
let iterations, solution = n_queens n in
let rec tab_line_columns i j =
if j < n then begin
let base_color = if i mod 2 = j mod 2 then "black" else "white" in
let html =
if solution.(j) = i then
"<TD WIDTH=20 HEIGHT=20 BGCOLOR=red> </TD>"
else
"<TD WIDTH=20 HEIGHT=20 BGCOLOR=" ^ base_color ^ "> </TD>"
in
html ^ tab_line_columns i (j+1)
end
else ""
in
let rec tab_lines i =
if i < n then
"<TR>" ^
tab_line_columns i 0 ^
"</TR>" ^
tab_lines (i+1)
else
""
in
"<BODY BGCOLOR=Olive><BR><CENTER><TABLE CELLSPACING=0 BORDER=0>" ^
tab_lines 0 ^
"</TABLE>" ^
"<BR><BR><FONT COLOR=white FACE=Helvetica,Arial>" ^
"Number of iterations: " ^ (string_of_int iterations) ^
"</FONT>" ^
"</CENTER></BODY>"
with
Not_found ->
"<BODY BGCOLOR=white><FONT color=red>No solution found!</FONT></BODY>"
| Failure f ->
"<BODY BGCOLOR=white><FONT color=red>Error during computation: Failure "
^ f ^ "</FONT></BODY>"
| _ ->
"<BODY BGCOLOR=white><FONT color=red>Error during computation!</FONT></BODY>"
;;
(************************* MAIN ************************)
register_callback "n_queens" 1 n_queens_callback
;;
sleep();;