1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
(***********************************************************************)
(* *)
(* FaCiLe *)
(* A Functional Constraint Library *)
(* *)
(* Nicolas Barnier, Pascal Brisset, LOG, CENA *)
(* *)
(* Copyright 2004 CENA. All rights reserved. This file is distributed *)
(* under the terms of the GNU Lesser General Public License. *)
(***********************************************************************)
(* $Id: queens.ml,v 1.22 2004/07/01 09:29:18 barnier Exp $ *)
open Facile
open Easy
(* Print a solution *)
let print queens =
let n = Array.length queens in
if n <= 10 then (* Pretty printing *)
for i = 0 to n - 1 do
let c = Fd.int_value queens.(i) in (* queens.(i) is bound *)
for j = 0 to n - 1 do
Printf.printf "%c " (if j = c then '*' else '-')
done;
print_newline ()
done
else (* Short print *)
for i = 0 to n-1 do
Printf.printf "line %d : col %a\n" i Fd.fprint queens.(i)
done;
flush stdout;;
(* Solve the n-queens problem *)
let queens n =
(* n decision variables in 0..n-1 *)
let queens = Fd.array n 0 (n-1) in
(* 2n auxiliary variables for diagonals *)
let shift op = Array.mapi (fun i qi -> Arith.e2fd (op (fd2e qi) (i2e i))) queens in
let diag1 = shift (+~) and diag2 = shift (-~) in
(* Global constraints *)
Cstr.post (Alldiff.cstr queens);
Cstr.post (Alldiff.cstr diag1);
Cstr.post (Alldiff.cstr diag2);
(* Heuristic Min Size, Min Value *)
let h a = (Var.Attr.size a, Var.Attr.min a) in
let min_min = Goals.Array.choose_index (fun a1 a2 -> h a1 < h a2) in
(* Search goal *)
let labeling = Goals.Array.forall ~select:min_min Goals.indomain in
(* Solve *)
let bt = ref 0 in
if Goals.solve ~control:(fun b -> bt := b) (labeling queens) then begin
Printf.printf "%d backtracks\n" !bt;
print queens
end else
prerr_endline "No solution"
let _ =
if Array.length Sys.argv <> 2
then raise (Failure "Usage: queens <nb of queens>");
Gc.set ({(Gc.get ()) with Gc.space_overhead = 500}); (* May help except with an underRAMed system *)
queens (int_of_string Sys.argv.(1));;
|
