~ubuntu-branches/ubuntu/hardy/ocaml-doc/hardy

« back to all changes in this revision

Viewing changes to examples/basics/queens.ml

  • Committer: Bazaar Package Importer
  • Author(s): Samuel Mimram
  • Date: 2007-09-08 01:49:22 UTC
  • mfrom: (0.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070908014922-lvihyehz0ndq7suu
Tags: 3.10-1
* New upstream release.
* Removed camlp4 documentation since it is not up-to-date.
* Updated to standards version 3.7.2, no changes needed.
* Updated my email address.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
(***********************************************************************)
2
 
(*                                                                     *)
3
 
(*                           Objective Caml                            *)
4
 
(*                                                                     *)
5
 
(*               Pierre Weis, projet Cristal, INRIA Rocquencourt       *)
6
 
(*                                                                     *)
7
 
(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
8
 
(*  en Automatique.  All rights reserved.  This file is distributed    *)
9
 
(*  only by permission.                                                *)
10
 
(*                                                                     *)
11
 
(***********************************************************************)
12
 
 
13
 
(*                         E I G H T   Q U E E N S
14
 
 
15
 
 The Eight Queens Program.
16
 
 
17
 
 How to set n queens on a chessboard of size n such that none
18
 
 can catch one each other.
19
 
 
20
 
 The program computes and prints the set of solutions
21
 
 (without removing symmetrical solutions).
22
 
 
23
 
 Program first compiled in ML V6.2 in 1987.
24
 
 
25
 
 Interesting exercise: change the program such as to be able to compute
26
 
 solutions for sizes greater than a few dozens.
27
 
 
28
 
*)
29
 
 
30
 
(* 1. Resolution of the n queens problem. *)
31
 
 
32
 
open List;;
33
 
 
34
 
let rec interval n m =
35
 
 if n > m then [] else n :: interval (n + 1) m;;
36
 
 
37
 
let filter_append p l l0 = 
38
 
  let rec filter = function
39
 
    | [] -> l0
40
 
    | h :: t -> if p h then h :: filter t else filter t in
41
 
   filter l;;
42
 
 
43
 
let rec concmap f = function
44
 
  | [] -> []
45
 
  | h :: t -> f h (concmap f t);;
46
 
 
47
 
let rec safe x d  = function
48
 
  | [] -> true
49
 
  | h :: t ->
50
 
     x <> h && x <> h + d && x <> h - d && safe x (d + 1) t;;
51
 
 
52
 
let rec ok = function
53
 
  | [] -> true
54
 
  | h :: t -> safe h 1 t;;
55
 
 
56
 
let find_solutions size =
57
 
 let line = interval 1 size in
58
 
 let rec gen n size =
59
 
   if n = 0 then [[]] else
60
 
   concmap 
61
 
    (fun b -> filter_append ok (map (fun q -> q :: b) line))
62
 
    (gen (n - 1) size) in
63
 
 gen size size;;
64
 
 
65
 
(* 2. Printing results. *)
66
 
 
67
 
let print_solutions size solutions =
68
 
 let sol_num = ref 1 in
69
 
 iter
70
 
   (fun chess ->
71
 
     Printf.printf "\nSolution number %i\n" !sol_num;
72
 
     sol_num := !sol_num + 1;
73
 
     iter
74
 
       (fun line ->
75
 
         let count = ref 1 in
76
 
         while !count <= size do
77
 
           if !count = line then print_string "Q " else print_string "- ";
78
 
           count := !count + 1
79
 
         done;
80
 
         print_newline ())
81
 
       chess)
82
 
   solutions;;
83
 
 
84
 
let print_result size =
85
 
 let solutions = find_solutions size in
86
 
 let sol_num = List.length solutions in
87
 
 Printf.printf "The %i queens problem has %i solutions.\n" size sol_num;
88
 
 print_newline ();
89
 
 let pr = 
90
 
   print_string "Do you want to see the solutions <n/y> ? "; read_line () in
91
 
 if pr = "y" then print_solutions size solutions;;
92
 
 
93
 
(* 3. Main program. *)
94
 
 
95
 
let queens () =
96
 
 let size = 
97
 
   print_string "Chess boards's size ? "; read_int () in
98
 
 print_result size;;
99
 
 
100
 
if !Sys.interactive then () else queens ();;