(*
 * lablai - An ML Artificial Inteligence library
 * Copyright (C) 2006  Till Crueger
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
(* File $RCSfile$ *)
(* last edited by $Author: till_crueger $ *)
(* $Date: 2008-01-24 13:46:37 +0100 (Do, 24 Jan 2008) $, $Revision: 48 $ *)

module type Game =
   sig
      type gameField;;
      type move;;
      
      val get_moves : gameField -> move list;;
      val make_move : move -> gameField -> gameField;;
      val is_endpos : gameField -> bool;;
   end;;

module type M =
   sig
      type gameField;;
      type move;;
      
      val byDepth : (gameField -> float) -> int -> gameField -> move;;
      val byTime : (gameField -> float) -> float -> gameField -> move;;
      val byNodes : (gameField -> float) -> int -> gameField -> move;;
   end;;
   
module Make (G: Game) =
   struct 
   
      type gameField = G.gameField;;
      type move = G.move;;
      
      exception Abort;;

      let negaMax estimator startPos check =
         let rec search poss mv_num depth alpha beta sgn =
            match poss with
               pos :: poss -> 
                  (* Generate this position, if not done already *)
                  let pos = Lazy.force pos in
                  let est =
                     if (not (check (depth+1))) || (G.is_endpos pos) then
                        sgn *. (estimator pos)
                     else
                        (* generate moves after this one *)
                        let moves = G.get_moves pos in
                        let next_poss = List.map (fun m -> lazy (G.make_move m pos)) moves in
                        (* Search on by taking this move*)
                        (* See negaMax explanation to understand the sign reversals *)
                        let (est,_) = search next_poss 0 (depth+1) (-.beta) (-.alpha) (-.sgn) in
                        -.est
                  in
                  (* see if we can improve and search other moves on this level *)
                  if est > alpha then
                     (* Alpha-Beta-Cut with fail-hard *)
                     if est > beta then
                        (* this move is so good, our opponent will never
                           let us do this *)
                           (beta,-2)
                     else
                        (* Yes we have improved, but not too far *)
                        search poss 0 depth est beta sgn
                  else
                     search poss (mv_num+1) depth alpha beta sgn
            |  [] -> (alpha,mv_num)
         in
         let moves = G.get_moves startPos in
         let poss = List.map (fun m -> lazy (G.make_move m startPos)) moves in
         (* we are only interested in the number of the chosen move *)
         let (_,mv_num) = search poss 0 0 neg_infinity infinity 1.0 in
         let rec get_mv mvs mv_num =
            match mvs with
               mv :: mvs -> if mv_num=0 then mv else get_mv mvs (mv_num-1)
            |  [] -> failwith "This should not happen"
         in
         get_mv (List.rev moves) mv_num
         ;;
      
      let byDepth estimator max_depth startPos =
         let check depth =
            max_depth >= depth
         in
         negaMax estimator startPos check
      ;;
      
      let byTime estimator max_time startPos =
         let startTime = Sys.time () in
               let rec loop n =
                  let check depth = 
               if depth > n then 
                  false
               else if (startTime -. Sys.time ()) > max_time then
                  (* Quick Abort in case time runs out *)
                  raise Abort
               else
                  true
            in
            let est = negaMax estimator startPos check in
            try loop (n+1)
            with Abort -> est
         in
         loop 0
         ;;
        
      let byNodes estimator max_Nodes startPos =
         let rec loop n =
            let check () =
               let count = ref 0 in
               (fun depth ->
                  count := !count +1; 
                  if depth > n then
                     false
                  else if !count > max_Nodes then
                     raise Abort
                  else
                     true
               )
            in
            let est = negaMax estimator startPos (check ()) in
            try loop (n+1)
            with Abort -> est
         in
         loop 0
         ;;

   end;;

(* 
 * $Log$
 * Revision 1.2  2008/01/20 15:43:17  till_crueger
 * - Rebuilt MiniMax search using the NegaMax variant with Alpha-Beta-Pruning
 *
 * Revision 1.1  2008/01/13 22:02:10  till_crueger
 *
 * - Added begin of framework for minimax search on 2-Player-Adversary Games
 *
 *)