open Features;;

(* 
let features1 =
  [ stablePieces, 2000;
    cornerPieces, 1000;
    xPieces, -500;
    pieceCount, 100;
    moveCount, 400;
    frontierPieces, -200;
    edgeTraps, 600 ];;

let features2 =
  [ stablePieces, 2000;
    cornerPieces, 1000;
    xPieces, -500;
    pieceCount, 300;
    moveCount, 400;
    frontierPieces, -200;
    edgeTraps, 200 ];;
*)

let features1 =
  [|2000.0;				(* stablePieces *)
    1000.0;				(* cornerPieces *)
    -500.0;				(* xPieces *)
    100.0;				(* pieceCount *)
    400.0;				(* moveCount *)
    -200.0;				(* frontierPieces *)
    600.0 |];;				(* edgeTraps *)

let features2 =
  [|2000.0;				(* stablePieces *)
    1000.0;				(* cornerPieces *)
    -500.0;				(* xPieces *)
    300.0;				(* pieceCount *)
    400.0;				(* moveCount *)
    -200.0;				(* frontierPieces *)
    200.0 |];;				(* edgeTraps *)
    
let features = ref features1;;

(* returns a pair of values, (black's val, white's val) *)

(*
let evalFun brd =
  List.fold_left
    (fun (gb, gw) (f, we) ->
      let (b, w) = f brd in
      (gb +. (float we) *. 
	 (if b = 0 then -.(float w) 
         else (float b ) /. (if w = 0 then 0.5 else float w)),
       gw +. (float we) *.
	 (if w = 0 then -.(float b)
	 else (float w) /. (if b = 0 then 0.5 else float b))) )
    (0.0, 0.0) !features
*)

let evalFun brd =
  let bmoves = Board.legalMoves brd Board.Black
  and wmoves = Board.legalMoves brd Board.White in
  let nbmoves = if bmoves = [Board.Pass] then 0 else List.length bmoves
  and nwmoves = if wmoves = [Board.Pass] then 0 else List.length wmoves in

  let vals = [|
    stablePieces brd;
    cornerPieces brd;
    xPieces brd;
    pieceCount brd;
    (nbmoves, nwmoves);
    (let bl, wh = frontierPieces brd in (bl - nbmoves, wh - nwmoves));
    edgeTraps brd
  |] in
  let bl, wh = XArray.fold_lefti (fun i (gb, gw) (b, w) ->
    (gb +. !features.(i) *.
       (if b = 0 then -.(float w)
       else (float b) /. (if w = 0 then 0.5 else float w)),
     gw +. !features.(i) *.
       (if w = 0 then -.(float b)
       else (float w) /. (if b = 0 then 0.5 else float b))) )
    (0.0, 0.0) vals in
  (bl, wh, bmoves, wmoves)

type successor = {
    brd: Board.t;
    myval: float;
    opval: float;
    opmoves: Board.move list
  }
      
module SuccQueue = PQueue.Make(
  struct
    type t = successor
    let compare s1 s2 = Pervasives.compare s1.myval s2.myval
  end)

(* to be used for benchmarks *)
let numEvalled = ref 0
    
(* this is a wrapper around negaMax *)
let findMove state player depth =
  let rec negaMax succ player depth alpha beta =
    incr numEvalled;
    let moves = succ.opmoves
    and opp = Board.opponent player in
    if moves = [Board.Pass] && not (Board.canMove succ.brd opp) then
      let weight = if player = Board.Black then 10000 else ~-10000 in
      float ((Board.blackPieces succ.brd - Board.whitePieces succ.brd) * weight)
    else if depth <= 0 then		(*search cutoff*)
      succ.opval
    else begin				(*search continues*)
      let succs = SuccQueue.create 40 succ in
      List.iter				(*add states to priority queue*)
      	(if player = Board.Black then
      	  (function m -> 
	    let brd = Board.makeMove succ.brd player m in
	    let bl, wh, bm, wm = evalFun brd in
	    SuccQueue.enq succs {brd=brd; myval=bl; opval=wh; opmoves=wm})
      	else
      	  (function m -> 
	    let brd = Board.makeMove succ.brd player m in
	    let bl, wh, bm, wm = evalFun brd in
	    SuccQueue.enq succs {brd=brd; myval=wh; opval=bl; opmoves=bm}))
      	moves;
      let alphr = ref alpha in
      (try while not (SuccQueue.empty succs) do
      	let s = SuccQueue.deq succs in
      	alphr := max !alphr
	     (-.(negaMax s opp (pred depth) (-. beta) (-. !alphr)));
      	if !alphr >= beta then raise Exit
      done with Exit -> ());
      !alphr
    end  in
  
  numEvalled := 0;
  let moves = Board.legalMoves state player 
  and opp = Board.opponent player in
  if (List.length moves) = 1 then
    List.hd moves
  else
    let succs = Sort.list (fun s1 s2 -> s1.myval >= s2.myval)
      	(List.map
	   (function move ->
	     let brd = Board.makeMove state player move in
	     let eb, ew, mb, mw = evalFun brd in
	     if player = Board.Black then
	       {brd=brd; myval=eb; opval=ew; opmoves=mw}
	     else
	       {brd=brd; myval=ew; opval=eb; opmoves=mb})
	   moves)
    and alpha = float min_int
    and beta = float max_int in
    (* find the successor with the max alpha value *)
    snd (List.fold_left
	   (fun (alph, mv) s ->
	     let a = max alph (-.negaMax s opp
				 (pred depth) (-. beta) (-. alph)) in
	     if a > alph then (a, Board.lastMove s.brd) else (alph, mv))
	   (alpha, List.hd moves) succs)
      
	    
let findMove_wld state player =
  let rec negaMax_end state player alpha beta =
    incr numEvalled;
    let moves = Board.legalMoves state player
    and opp = Board.opponent player in
    if moves = [Board.Pass] && not (Board.canMove state opp) then
      let weight = if player = Board.Black then 1 else ~-1 in
      float
      	(weight * (compare (Board.blackPieces state) (Board.whitePieces state)))
    else				(*search continues*)
      let alphr = ref alpha in
      if (List.exists
	    (function move ->
	      let brd = Board.makeMove state player move in
	      alphr := max !alphr
		   (-.(negaMax_end brd opp (-. beta) (-. !alphr)));
	      !alphr >= beta)
	    moves) then
      	beta
      else
      	!alphr in
  
  numEvalled := 0;
  let moves = Board.legalMoves state player 
  and opp = Board.opponent player in
  if (List.length moves) = 1 then
    List.hd moves
  else
    let succs = List.map (Board.makeMove state player) moves
    and alpha = float min_int
    and beta = float max_int in
    (* find the successor with the max alpha value *)
    snd (List.fold_left
	   (fun (alph, best) brd ->
	     let a = max alph
		 (-.negaMax_end brd opp (-. beta) (-. alph)) in
	     if a > alph then (a, Board.lastMove brd) else (alph, best))
	   (alpha, List.hd moves) succs)

      
let findMove_end state player =
  let rec negaMax_end state player alpha beta =
    incr numEvalled;
    let moves = Board.legalMoves state player
    and opp = Board.opponent player in
    if moves = [Board.Pass] && not (Board.canMove state opp) then
      let weight = if player = Board.Black then 1 else ~-1 in
      float((Board.blackPieces state - Board.whitePieces state) * weight)
    else				(*search continues*)
      let alphr = ref alpha in
      if (List.exists
	    (function move ->
	      let brd = Board.makeMove state player move in
	      alphr := max !alphr
		   (-.(negaMax_end brd opp (-. beta) (-. !alphr)));
	      !alphr >= beta)
	    moves) then
      	beta
      else
      	!alphr in
  
  numEvalled := 0;
  let moves = Board.legalMoves state player 
  and opp = Board.opponent player in
  if (List.length moves) = 1 then
    List.hd moves
  else
    let succs = List.map (Board.makeMove state player) moves
    and alpha = float min_int
    and beta = float max_int in
    (* find the successor with the max alpha value *)
    snd (List.fold_left
	   (fun (alph, best) brd ->
	     let a = max alph
		 (-.negaMax_end brd opp (-. beta) (-. alph)) in
	     if a > alph then (a, Board.lastMove brd) else (alph, best))
	   (alpha, List.hd moves) succs)

      
      
let machinePlayer depth1 depth2 depth3 brd =
  let me = Board.turn brd
  and npieces = Board.blackPieces brd + Board.whitePieces brd in
  if npieces < 40 then
    features := features1
  else
    features := features2;
  if npieces = 4 then			(* first move, doesn't matter *)
    Some (List.nth (Board.legalMoves brd Board.Black) (Random.int 4))
  else begin
    flush stdout;
    let start = Unix.gettimeofday() in
    let move = 
      if npieces < (64 - depth2) then
      	Some (findMove brd me depth1)
      else if npieces < (64 - depth3) then
      	Some (findMove_wld brd me)
      else
      	Some (findMove_end brd me) in
    Printf.printf "Evalled %.2f pos/sec.\n"
      ((float !numEvalled) /. (Unix.gettimeofday() -. start)); flush stdout;
    move
  end
