<br />
<b>Deprecated</b>:  The each() function is deprecated. This message will be suppressed on further calls in <b>/home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php</b> on line <b>456</b><br />
(*
 * Search: functorized code for BFS, DFS and IDS
 * Copyright (C) 2003 Jean-Christophe FILLIATRE
 * 
 * This software is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public
 * License version 2, as published by the Free Software Foundation.
 * 
 * This software 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 Library General Public License version 2 for more details
 * (enclosed in the file LGPL).
 *)

(*s Functional search *)

module type FunctionalProblem = sig
  type state
  type move
  val success : state -> bool
  val moves : state -> (move * state) list
  type marked_state
  val mark : state -> marked_state option
end

(* Depth-first search *)
module FunctionalDFS(P : FunctionalProblem) = struct

  let search s0 = 
    let visited = Hashtbl.create 65537 in
    let already s = match P.mark s with
      | None -> false
      | Some h -> (Hashtbl.mem visited h) || (Hashtbl.add visited h (); false)
    in
    let rec dfs path s =
      if already s then raise Not_found;
      if P.success s then s, List.rev path else first path (P.moves s)
    and first path = function
      | [] -> raise Not_found
      | (m,s) :: r -> try dfs (m :: path) s with Not_found -> first path r
    in
    dfs [] s0

end

(* Breadth-first search *)
module FunctionalBFS(P : FunctionalProblem) = struct

  let search s0 = 
    let visited = Hashtbl.create 65537 in
    (* meaning is here ``already queued'' *)
    let already s = match P.mark s with
      | None -> false
      | Some h -> (Hashtbl.mem visited h) || (Hashtbl.add visited h (); false)
    in
    let _ = already s0 in
    let q = Queue.create () in
    Queue.add ([],s0) q;
    let rec bfs () =
      if Queue.length q = 0 then raise Not_found;
      let path,s = Queue.take q in
      if P.success s then 
	s, List.rev path
      else begin
	List.iter 
	  (fun (m,s') -> if not (already s') then Queue.add (m :: path, s') q) 
	  (P.moves s);
	bfs ()
      end
    in
    bfs ()

end

(* Iterative deepening search *)
module FunctionalIDS(P : FunctionalProblem) = struct
  
  let search s0 = 
    let visited = Hashtbl.create 65537 in
    let already s = match P.mark s with
      | None -> false
      | Some h -> (Hashtbl.mem visited h) || (Hashtbl.add visited h (); false)
    in
    let depth max =
      let rec dfs n path s =
	if n > max || already s then raise Not_found;
	if P.success s then s, List.rev path else first n path (P.moves s)
      and first n path = function
	| [] -> 
	    raise Not_found
	| (m,s) :: r -> 
	    try dfs (succ n) (m :: path) s with Not_found -> first n path r
      in
      dfs 0 [] s0
    in
    let rec try_depth d = 
      try depth d with Not_found -> Hashtbl.clear visited; try_depth (succ d)
    in
    try_depth 0

end


(*s Imperative search *)

module type ImperativeProblem = sig
  type move
  val success : unit -> bool
  val moves : unit -> move list
  val do_move : move -> unit
  val undo_move : move -> unit
  type marked_state
  val mark : unit -> marked_state option
end

(* Depth-first search *)
module ImperativeDFS(P : ImperativeProblem) = struct

  let search () = 
    let visited = Hashtbl.create 65537 in
    let already () = match P.mark () with
      | None -> false
      | Some h -> (Hashtbl.mem visited h) || (Hashtbl.add visited h (); false)
    in
    let rec dfs path =
      if already () then raise Not_found;
      if P.success () then List.rev path else first path (P.moves ())
    and first path = function
      | [] -> 
	  raise Not_found
      | m :: r -> 
	  try P.do_move m; dfs (m :: path) 
	  with Not_found -> P.undo_move m; first path r
    in
    dfs []

end

(* Breadth-first search *)
module ImperativeBFS(P : ImperativeProblem) = struct

  (* cut [n] elements at head of list [l] *)
  let rec cut_head n l = if n == 0 then l else cut_head (pred n) (List.tl l)

  (* find the common physical suffix of [l1] and [l2] *)
  let common_psuffix (n1,l1) (n2,l2) = 
    (* [suffix] applies when the two lists have same length *)
    let rec suffix l1 l2 = 
      if l1 == l2 then l1 else suffix (List.tl l1) (List.tl l2)
    in
    if n1 < n2 then suffix l1 (cut_head (n2 - n1) l2)
    else if n2 < n1 then suffix (cut_head (n1 - n2) l1) l2
    else suffix l1 l2

  let search () = 
    let visited = Hashtbl.create 65537 in
    let already () = match P.mark () with
      | None -> false
      | Some h -> (Hashtbl.mem visited h) || (Hashtbl.add visited h (); false)
    in
    let q = Queue.create () in
    Queue.add (0,[]) q;
    let cpath = ref (0,[]) in
    let rec restore_state path =
      let suf = common_psuffix path !cpath in
      let rec backward = function
	| (m :: r) as p when p != suf -> P.undo_move m; backward r
	| _ -> () 
      in
      let rec forward = function
	| (m :: r) as p when p != suf -> forward r; P.do_move m 
	| _ -> ()
      in
      backward (snd !cpath);
      forward (snd path);
      cpath := path
    in
    let rec bfs () =
      if Queue.length q = 0 then raise Not_found;
      let (n,path) as s = Queue.take q in
      restore_state s;
      if P.success () then 
	List.rev path
      else if not (already ()) then begin
	List.iter (fun m -> Queue.add (succ n, m :: path) q) (P.moves ());
	bfs ()
      end else
	bfs ()
    in
    bfs ()

end

(* Iterative deepening search *)
module ImperativeIDS(P : ImperativeProblem) = struct

  let search () = 
    let visited = Hashtbl.create 65537 in
    let already () = match P.mark () with
      | None -> false
      | Some h -> (Hashtbl.mem visited h) || (Hashtbl.add visited h (); false)
    in
    let depth max = 
      let rec dfs n path =
	if n > max || already () then raise Not_found;
	if P.success () then List.rev path else first n path (P.moves ())
      and first n path = function
	| [] -> 
	    raise Not_found
	| m :: r -> 
	    try P.do_move m; dfs (succ n) (m :: path) 
	    with Not_found -> P.undo_move m; first n path r
      in
      dfs 0 []
    in
    let rec try_depth d = 
      Printf.eprintf "trying depth %d...\n" d; flush stderr;
      try depth d with Not_found -> Hashtbl.clear visited; try_depth (succ d) 
    in
    try_depth 0

end