
{**
  @abstract(Recherche du meilleur coup.)
  Recherche du meilleur coup.
}

unit Best2;

interface

uses
  Chess;

function GetBestMove(const APos: TPosition; const AChess960: boolean; const ATime: integer; var AMove: string; const ARandom: boolean = FALSE): string;

var
  LFactorPiecePrior,
  LFactorPawnStruct,
  LFactorTargets,
  LFactorCastling,
  LFactorEnPassant,
  LFactorCheck,
  LFactorProtect,
  LFactorAttack,
  LFactorPawnMobil,
  LFactorNewPos: integer;
  
implementation

uses
  SysUtils, Move, Moves, Castling, Board, Bitboards, History{$IFDEF DEBUG}, Log{$ENDIF};

var
  LEndTime: cardinal;
{$IFDEF DEBUG}
  LLog: TLog;
{$ENDIF}

type
  TEvalFunc = function(const APos: TPosition; const AMove: TMove): integer;

function Eval0(const APos: TPosition; const AMove: TMove): integer;
var
  LPos: TPosition;
begin
  LPos := APos;
  result := 0;
  if DoMove(LPos, AMove) then
  begin
    LPos.Side := not LPos.Side;
    result := Ord(not IsCheck(LPos));
  end;
end;

const
  CMax = 99999;
  CMin = -1 * CMax;
  CValue: array[ptWhitePawn..ptQueen] of integer = (100, 100, 500, 320, 340, 860);
  
function MaterialAdvantage(const APos: TPosition): integer;
var
  LIdx: integer;
  LType: TPieceType;
  LPieces: TBoard;
begin
  if (APos.Pieces[APos.Side] and APos.Kings) = 0 then
    Exit(CMin);

  if (APos.Pieces[not APos.Side] and APos.Kings) = 0 then
    Exit(CMax);

  result := 0;

  LPieces := APos.Pieces[FALSE] and not APos.Kings;
  while LPieces <> 0 do
  begin
    LIdx := BsfQWord(QWord(LPieces));
    LType := PieceTypeIdx(APos, LIdx);
    Inc(result, CValue[LType]);
    LPieces := LPieces and not CIdxToSqr[LIdx];
  end;

  LPieces := APos.Pieces[TRUE] and not APos.Kings;
  while LPieces <> 0 do
  begin
    LIdx := BsfQWord(QWord(LPieces));
    LType := PieceTypeIdx(APos, LIdx);
    Dec(result, CValue[LType]);
    LPieces := LPieces and not CIdxToSqr[LIdx];
  end;

  if APos.Side then
    result := -1 * result;
end;

function PositionalAdvantage(const APos: TPosition): integer;
var
  LPos: TPosition;
  LCastling, LEnPassant, LCheck, LTargets, LProtect, LAttacks, LPawnStruct, LPawnMobil, LPiecePrior, LNewPos: integer;
begin
  LPos := APos;
  LPiecePrior := 0;
  LCastling := 0;
  LEnPassant := 0;
  LCheck := {Ord(IsCheck(LPos))}0;
  LProtect := {CountProtections(LPos)}0;
  LAttacks := CountAttacks(LPos);
  LPawnStruct := {PawnStruct(LPos)}0;
  LTargets := {CountTargets(LPos)}0;
  LPawnMobil := {PawnMovesCount(LPos)}0;
  LNewPos := {Ord(not FindInHistory(LPos))}0;
  
  LPiecePrior := LFactorPiecePrior * LPiecePrior;
  LCastling   := LFactorCastling   * LCastling;
  LEnPassant  := LFactorEnPassant  * LEnPassant;
  LCheck      := LFactorCheck      * LCheck;
  LProtect    := LFactorProtect    * LProtect;
  LAttacks    := LFactorAttack     * LAttacks;
  LTargets    := LFactorTargets    * LTargets;
  LPawnStruct := LFactorPawnStruct * LPawnStruct;
  LPawnMobil  := LFactorPawnMobil  * LPawnMobil;
  LNewPos     := LFactorNewPos     * LNewPos;

{$IFDEF DEBUG}
{
  LLog.LogLn(Format(
    '%-5s PieceType %0.2d Castling %0.2d EnPassant %0.2d Check %0.2d Protections %0.2d Attacks %0.2d Targets %0.2d PawnStruct %0.2d PawnMobil %0.2d NewPos %0.2d',
    [LMoveStr, LPiecePrior, LCastling, LEnPassant, LCheck, LProtect, LAttacks, LTargets, LPawnStruct, LPawnMobil, LNewPos]
  ));
}
{$ENDIF}

  result :=
    LPiecePrior
  + LCastling
  + LEnPassant
  + LCheck
  + LProtect
  + LAttacks
  + LTargets
  + LPawnStruct
  + LPawnMobil
  + LNewPos
  ;
end;

function MiniMax(const APos: TPosition): integer;
var
  LMov: array[1..2, 0..199] of TMove;
  LPos: array[1..2] of TPosition;
  LCnt: array[1..2] of integer;
  LRes, LMax: integer;
  i, j: integer;
begin
  Initialize(LMov);
  result := High(integer);
  GenerateMoves(APos, LMov[1], LCnt[1]);
  for i := 0 to Pred(LCnt[1]) do
  begin
    LPos[1] := APos;
    if DoMove(LPos[1], LMov[1][i]) then
    begin
      GenerateMoves(LPos[1], LMov[2], LCnt[2]);
      LMax := Low(integer);
      for j := 0 to Pred(LCnt[2]) do
      begin
        LPos[2] := LPos[1];
        if DoMove(LPos[2], LMov[2][j]) then
        begin
          LPos[2].Side := not LPos[2].Side;
          if IsCheck(LPos[2]) then LRes := CMin else LRes := MaterialAdvantage(LPos[2]) + PositionalAdvantage(LPos[2]);
        end else
          Continue;
        if LRes > LMax then
        begin
          LMax := LRes;
          if LMax = CMax then
            Break;
        end;
      end;
      if LMax < result then
        result := LMax;
    end else
      Continue;
  end;
end;

function Eval1(const APos: TPosition; const AMove: TMove): integer;
var
  LPos: TPosition;
begin
  LPos := APos;
  if DoMove(LPos, AMove) then
    result := MiniMax(LPos)
  else
    result := Low(integer);
end;

procedure Sort(var AMoves: array of TMove; var AValues: array of integer; const ACount: integer);

  procedure Swap(var AArr: array of integer; const AIdx: integer); overload;
  var
    LAux: integer;
  begin
    LAux           := AArr[AIdx];
    AArr[AIdx]     := AArr[AIdx + 1];
    AArr[AIdx + 1] := LAux;
  end;

  procedure Swap(var AArr: array of TMove; const AIdx: integer); overload;
  var
    LAux: TMove;
  begin
    LAux           := AArr[AIdx];
    AArr[AIdx]     := AArr[AIdx + 1];
    AArr[AIdx + 1] := LAux;
  end;

var
  LIdx: integer;
  LDone: boolean;
begin
  repeat
    LDone := TRUE;
    for LIdx := 0 to ACount - 2 do
      if AValues[LIdx] < AValues[LIdx + 1] then
      begin
        Swap(AMoves, LIdx);
        Swap(AValues, LIdx);
        LDone := FALSE;
      end;
  until LDone;
end;

function CountBestMoves(const AValues: array of integer; const AStop: integer): integer;
begin
  result := 1;
  while (result < AStop) and (AValues[result] = AValues[0]) do
    Inc(result);
end;

function GetBestMove(const APos: TPosition; const AChess960: boolean; const ATime: integer; var AMove: string; const ARandom: boolean): string;
var
  LList: array[0..199] of TMove;
  LEval: array[0..199] of integer;
  LCount: integer;

  procedure Evaluate(AFunc: TEvalFunc);
  var
    i: integer;
    LMove: TMove;
  begin
    for i := 0 to Pred(LCount) do
      LEval[i] := AFunc(APos, LList[i]);
    Sort(LList, LEval, LCount);
{$IFDEF DEBUG}
    LLog.LogLn(LList, LEval, LCount);
{$ENDIF}
    LCount := CountBestMoves(LEval, LCount);
    LMove := LList[Random(LCount)];
    if IsCastling(APos, LMove) and not AChess960 then
      RenameCastling(LMove);
    AMove := MoveToStr(LMove);
  end;

begin
  Initialize(LList);
  LEndTime := GetTickCount64 + 9 * ATime div 10;
{$IFDEF DEBUG}
  LLog.LogLn(Concat('** Position: ', DecodePosition(APos)));
  LLog.LogLn(Format('** Time available: %d ms', [ATime]));
{$ENDIF}
  GenerateMoves(APos, LList, LCount);
  GenerateCastling(APos, LList, LCount);
  Evaluate(@Eval0);
  if ARandom then
    Exit(AMove);
  
{
  while GetTickCount64 < LEndTime do
    Evaluate(@Eval1);
}
  
  Evaluate(@Eval1);
  
  result := AMove;
end;

{$IFDEF DEBUG}
initialization
  LLog := TLog.Create({$I %FILE%}, TRUE);
finalization
  LLog.Free;
{$ENDIF}
end.
