summaryrefslogtreecommitdiff
path: root/test/soli.ml
blob: 46d06b8287fa73f743077547c24cb5781c23d44f (plain)
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

type peg = Out | Empty | Peg

let board = [|
 [| Out; Out; Out; Out; Out; Out; Out; Out; Out|];
 [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
 [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
 [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
 [| Out; Peg; Peg; Peg; Empty; Peg; Peg; Peg; Out|];
 [| Out; Peg; Peg; Peg; Peg; Peg; Peg; Peg; Out|];
 [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
 [| Out; Out; Out; Peg; Peg; Peg; Out; Out; Out|];
 [| Out; Out; Out; Out; Out; Out; Out; Out; Out|]
|]


let print_peg = function
    Out -> print_string "."
  | Empty -> print_string " "
  | Peg -> print_string "$"


let print_board board =
 for i=0 to 8 do
   for j=0 to 8 do
    print_peg board.(i).(j)
   done;
   print_newline()
 done


type direction = { dx: int; dy: int }

let dir = [| {dx = 0; dy = 1}; {dx = 1; dy = 0};
             {dx = 0; dy = -1}; {dx = -1; dy = 0} |]

type move = { x1: int; y1: int; x2: int; y2: int }

let moves = Array.new 31 {x1=0;y1=0;x2=0;y2=0}

let counter = ref 0

exception Found

let rec solve m =
  counter := !counter + 1;
  if m = 31 then
    begin match board.(4).(4) with Peg -> true | _ -> false end
  else
    try
      if !counter mod 500 = 0 then begin
        print_int !counter; print_newline()
      end;
      for i=1 to 7 do
      for j=1 to 7 do
        match board.(i).(j) with
          Peg ->
            for k=0 to 3 do
              let d1 = dir.(k).dx in
              let d2 = dir.(k).dy in
              let i1 = i+d1 in
              let i2 = i1+d1 in
              let j1 = j+d2 in
              let j2 = j1+d2 in
              match board.(i1).(j1) with
                Peg ->
                  begin match board.(i2).(j2) with
                    Empty ->
(*
                      print_int i; print_string ", ";
                      print_int j; print_string ") dir ";
                      print_int k; print_string "\n";
*)
                      board.(i).(j) <- Empty;
                      board.(i1).(j1) <- Empty;
                      board.(i2).(j2) <- Peg;
                      if solve(m+1) then begin
                        moves.(m) <- { x1=i; y1=j; x2=i2; y2=j2 };
                        raise Found
                      end;
                      board.(i).(j) <- Peg;
                      board.(i1).(j1) <- Peg;
                      board.(i2).(j2) <- Empty
                    | _ -> ()
                  end
              | _ -> ()
            done
        | _ ->
            ()
      done
      done;
      false
    with Found ->
      true


let _ = if solve 0 then (print_string "\n"; print_board board)