~ubuntu-branches/ubuntu/intrepid/facile/intrepid

« back to all changes in this revision

Viewing changes to examples/magic.ml

  • Committer: Bazaar Package Importer
  • Author(s): Steffen Joeris
  • Date: 2005-11-22 19:18:05 UTC
  • Revision ID: james.westby@ubuntu.com-20051122191805-qys7cg0e9np0hx6j
Tags: upstream-1.1
ImportĀ upstreamĀ versionĀ 1.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(***********************************************************************)
 
2
(*                                                                     *)
 
3
(*                           FaCiLe                                    *)
 
4
(*                 A Functional Constraint Library                     *)
 
5
(*                                                                     *)
 
6
(*            Nicolas Barnier, Pascal Brisset, LOG, CENA               *)
 
7
(*                                                                     *)
 
8
(* Copyright 2004 CENA. All rights reserved. This file is distributed  *)
 
9
(* under the terms of the GNU Lesser General Public License.           *)
 
10
(***********************************************************************)
 
11
(* $Id: magic.ml,v 1.9 2001/06/01 14:13:09 barnier Exp $ *)
 
12
 
 
13
(*
 
14
  Magic Sequence
 
15
 
 
16
  A magic sequence is a sequence of N values (x0, x1, , xN-1) such
 
17
that 0 will appear in the sequence x0 times, 1 will appear x1
 
18
times,..., and N-1 will appear in the sequence xN-1 times. For example,
 
19
for N=3, the following sequence is a solution: (1, 2, 1, 0). That is,
 
20
0 is present once, 1 is present twice, 2 is present once, and 3 is not
 
21
present.
 
22
*)
 
23
 
 
24
open Facile
 
25
open Easy
 
26
 
 
27
let magic n =
 
28
  (* n variables *)
 
29
  let x = Fd.array n 0 (n-1) in
 
30
 
 
31
  (* Constraint: cardinality constraint with x as variables and cardinals *)
 
32
  let card_vals = Array.mapi (fun i x -> (x, i)) x in
 
33
  Cstr.post (Gcc.cstr ~level:Gcc.Medium x card_vals);
 
34
 
 
35
  (* Redundant constraints *)
 
36
  let vals = Array.init n (fun i -> i) in
 
37
  Cstr.post (Arith.scalprod_fd vals x =~ i2e n);
 
38
 
 
39
  (* Search goal: first fail with min domain size *)
 
40
  let min_size = 
 
41
    Goals.Array.choose_index (fun a1 a2 -> Var.Attr.size a1 < Var.Attr.size a2) in
 
42
  let goal = Goals.Array.forall ~select:min_size Goals.indomain x in
 
43
 
 
44
  (* Search *)
 
45
  if Goals.solve goal then begin
 
46
    Array.iter (fun v -> Printf.printf "%a " Fd.fprint v) x; print_newline ()
 
47
  end
 
48
  else
 
49
    prerr_endline "No solution";;
 
50
 
 
51
let _ =
 
52
  if Array.length Sys.argv < 2 then prerr_endline "Usage: magic <size>"
 
53
  else magic (int_of_string Sys.argv.(1));;