File: soli.ml

package info (click to toggle)
js-of-ocaml 5.9.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 32,020 kB
  • sloc: ml: 91,250; javascript: 57,289; ansic: 315; makefile: 271; lisp: 23; sh: 6; perl: 4
file content (122 lines) | stat: -rw-r--r-- 3,655 bytes parent folder | download | duplicates (3)
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(* $Id: soli.ml 2553 1999-11-17 18:59:06Z xleroy $ *)

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.make 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
    match board.(4).(4) with
    | Peg -> true
    | _ -> false
  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 -> (
                    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 (
                          moves.(m) <- { x1 = i; y1 = j; x2 = i2; y2 = j2 };
                          raise Found);
                        board.(i).(j) <- Peg;
                        board.(i1).(j1) <- Peg;
                        board.(i2).(j2) <- Empty
                    | _ -> ())
                | _ -> ()
              done
          | _ -> ()
        done
      done;
      false
    with Found -> true

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