(***********************************************************************)
(*                                                                     *)
(*                        Caml examples                                *)
(*                                                                     *)
(*            Pierre Weis                                              *)
(*                                                                     *)
(*                        INRIA Rocquencourt                           *)
(*                                                                     *)
(*  Copyright (c) 1994-2011, INRIA                                     *)
(*  All rights reserved.                                               *)
(*                                                                     *)
(*  Distributed under the BSD license.                                 *)
(*                                                                     *)
(***********************************************************************)

(* $Id: soli.ml,v 1.5 2011-08-08 19:31:17 weis Exp $ *)

(** This program solves the famous game ``Le solitaire'', using a
   trivial brute force algorithm (exhaustive exploration of the possible
   games, until a solution is found).

   No graphics involved here: the results are just printed out as ASCII
   characters! *)

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.create 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
      | Out | Empty -> 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
          | Out | Empty -> ()
          | 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
              | Out | Empty -> ()
              | Peg ->
                begin match board.(i2).(j2) with
                | Out | Peg -> ()
                | Empty ->
                    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 solve_solitaire () =
  if solve 0 then (print_string "\n"; print_board board)
;;

if !Sys.interactive then () else solve_solitaire ()
;;