(*
 * 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: 2007-12-15 19:53:03 +0100 (Sa, 15 Dez 2007) $, $Revision: 29 $ *)

let dfsearch ~start ~childgen ~goaltest ~combinator =
   let rec search start akku =
      (* see if we have reached a goal*)
      if goaltest start then 
         combinator start true akku
      else 
      (
         (* produce all children and descend their paths *)
         let childs = childgen start in
         let path = combinator start false akku in
         let rec loop childs =
            match childs with
               child :: childs ->
                  let res = search child path in
                  (* Was this path successfull?*)
                  if res = None then
                     loop childs
                  else
                     res
            | [] -> None 
         in
         loop childs
      )
      in
      search start None
   ;;

let boundeddfsearch ~start ~childgen ~goaltest ~combinator  ~depth  =
   let rec search start depth akku =
      (*check if we already have reached a goal*)
      if goaltest start then 
         combinator start true akku
      else 
         (* maybe we have reached the maximun depth*)
         if depth = 0 then
            None
         else
         (
            (* generate all the childs and loop over them*)
            let childs = childgen start in
            let path = combinator start false akku in
            let rec loop childs =
               match childs with
                  child :: childs ->
                     (* recursive call until we find a goal, or exceed the depth *)
                     let res = search child (depth-1) path in
                     if res = None then
                        loop childs
                     else
                        res
               | [] -> None 
            in
            loop childs
         )
      in 
      search start depth None
   ;;

let iterativedfs ~start ~childgen ~goaltest ~combinator =
   (* repeatedly call boundeddfsearch with increasing depth, until we find a solution*)
   let rec loop iter =
      let res = boundeddfsearch ~start ~childgen ~goaltest ~combinator ~depth:iter in
      if res = None then
         loop (iter+1)
      else
         res
   in
   loop 1
   ;;

let bfsearch ~start ~childgen ~goaltest ~combinator =
   (*create a queue to store all the unexpanded nodes*)
   let queue = Queue.create () in
   let rec search start akku () =
      (* test if we have reached a goal *)
      if goaltest start then 
         combinator start true akku
      else
         (* generate all the childs and the path leading up to them *)
         let childs = childgen start in
         let path = combinator start false akku in
         (* Add the partialy evaluated functions to the end of the queue *)
         let rec loop childs =
            match childs with
               child :: childs ->
                  Queue.push (Lazy.lazy_from_fun (search child path)) queue;
                  loop childs
            |  [] -> ()
         in
         loop childs;
         (* get the first function from the queue and evaluate it *)
         if Queue.is_empty queue then None else Lazy.force_val (Queue.pop queue)
   in
   search start None ()
   ;;

let res_comb node found _ =
   (* only return something when we have reached a goal *)
   if found then Some node else None
   ;;

let path_comb node found hist =
   (* add the current node to the list *)
   let res =
      match hist with
         None -> node :: []
      | Some hist -> node :: hist
   in
   (* when we have reached a goal, it is save to reverse the list
   (no further search at this point)*)
   if found then Some (List.rev res) else Some res
   ;;
   
let exhaustive_search ~start ~childgen ~goaltest ~combinator =
   let res = ref [] in
   let rec search start akku =
      (* see if we have reached a goal*)
      if goaltest start then 
         (*add the current solution to the list of results*)
         match (combinator start true akku) with
            Some solution -> res := solution :: !res
         | None -> ()
      else ();
      
      (* produce all children and descend their paths *)
      let childs = childgen start in
      let path = combinator start false akku in
      let rec loop childs =
         match childs with
            child :: childs ->
               (* descend *)
               search child path;
               (* look at sibblings *)
               loop childs
            | [] -> () 
      in
      loop childs
      
      in
      search start None;
      !res
   ;;
   
(* 
 * $Log$
 * Revision 1.6  2007/12/15 18:52:58  till_crueger
 * - Updated documentation
 * - Moved Log-Tags to a better position in the sources
 *
 * Revision 1.5  2006/03/26 17:58:25  till_crueger
 * Major code cleanup and improvment of the documentation.
 *
 * Revision 1.4  2006/02/20 20:21:46  till
 * Added LGPL to all files
 * Added LGPL to package
 *
 * Revision 1.3  2006/02/20 17:36:01  till
 * Improved Makefile
 *
 * Fixed some minor problems so they won't cause warnings
 *
 * Revision 1.2  2006/02/11 11:11:12  till
 * Added CVS Tags
 *
 *)