test/soli.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15
  16 type peg = Out | Empty | Peg
  17
  18 let board = [|
  19  [| Out; Out; Out; Out; Out; Out; Out; Out; Out|];
  20  [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
  21  [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
  22  [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
  23  [| Out; Peg; Peg; Peg; Empty; Peg; Peg; Peg; Out|];
  24  [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
  25  [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
  26  [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
  27  [| Out; Out; Out; Out; Out; Out; Out; Out; Out|]
  28 |]
  29
  30
  31 let print_peg = function
  32     Out -> print_string "."
  33   | Empty -> print_string " "
  34   | Peg -> print_string "$"
  35
  36
  37 let print_board board =
  38  for i=0 to 8 do
  39    for j=0 to 8 do
  40     print_peg board.(i).(j)
  41    done;
  42    print_newline()
  43  done
  44
  45
  46 type direction = { dx: int; dy: int }
  47
  48 let dir = [| {dx = 0; dy = 1}; {dx = 1; dy = 0};
  49              {dx = 0; dy = -1}; {dx = -1; dy = 0} |]
  50
  51 type move = { x1: int; y1: int; x2: int; y2: int }
  52
  53 let moves = Array.create 31 {x1=0;y1=0;x2=0;y2=0}
  54
  55 let counter = ref 0
  56
  57 exception Found
  58
  59 let rec solve m =
  60   counter := !counter + 1;
  61   if m = 31 then
  62     begin match board.(4).(4) with Peg -> true | _ -> false end
  63   else
  64     try
  65       if !counter mod 500 = 0 then begin
  66         print_int !counter; print_newline()
  67       end;
  68       for i=1 to 7 do
  69       for j=1 to 7 do
  70         match board.(i).(j) with
  71           Peg ->
  72             for k=0 to 3 do
  73               let d1 = dir.(k).dx in
  74               let d2 = dir.(k).dy in
  75               let i1 = i+d1 in
  76               let i2 = i1+d1 in
  77               let j1 = j+d2 in
  78               let j2 = j1+d2 in
  79               match board.(i1).(j1) with
  80                 Peg ->
  81                   begin match board.(i2).(j2) with
  82                     Empty ->
  83 (*
  84                       print_int i; print_string ", ";
  85                       print_int j; print_string ") dir ";
  86                       print_int k; print_string "\n";
  87 *)
  88                       board.(i).(j) <- Empty;
  89                       board.(i1).(j1) <- Empty;
  90                       board.(i2).(j2) <- Peg;
  91                       if solve(m+1) then begin
  92                         moves.(m) <- { x1=i; y1=j; x2=i2; y2=j2 };
  93                         raise Found
  94                       end;
  95                       board.(i).(j) <- Peg;
  96                       board.(i1).(j1) <- Peg;
  97                       board.(i2).(j2) <- Empty
  98                     | _ -> ()
  99                   end
 100               | _ -> ()
 101             done
 102         | _ ->
 103             ()
 104       done
 105       done;
 106       false
 107     with Found ->
 108       true
 109
 110
 111 let _ = if solve 0 then (print_string "\n"; print_board board)