source: tags/1.2.0/Forms/UFormComputer.pas

unit UFormComputer;

{$mode delphi}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  UGame, fgl;

type
  { TGameTry }

  TGameTry = class
    Game: TGame;
    Moves: array of TMoveDirection;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TGameTry);
  private
    function GetFitness: Double;
    function GetFitnessSnake: Double;
  end;

  TGameTries = class(TFPGObjectList<TGameTry>)
  end;

  { TFormComputer }

  TFormComputer = class(TForm)
    ButtonStart: TButton;
    ButtonStop: TButton;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    Stop: Boolean;
    GameTries1: TGameTries;
    GameTries2: TGameTries;
    GameTries3: TGameTries;
    GameTries4: TGameTries;
    procedure TryAllDirections(GameTries: TGameTries; GameTry: TGameTry);
  public

  end;

var
  FormComputer: TFormComputer;

implementation

{$R *.lfm}

uses
  UCore;

{ TGameTry }

function TGameTry.GetFitness: Double;
const
  DirWeight: array[TMoveDirection] of Double = (0, 0.25, -10000, 0.5, 0.75);
var
  I: Integer;
  WeightSnake: Double;
  WeightMoves: Double;
  WeightScore: Double;
  WeightSteps: Double;
begin
  WeightSnake := 1000 * GetFitnessSnake;

  WeightMoves := 0;
  for I := 0 to Length(Moves) - 1 do
    WeightMoves := WeightMoves + DirWeight[Moves[I]];
  WeightMoves := WeightMoves / Length(Moves);

  WeightScore := 100 * Game.Score / Game.Board.GetValueSum;
  WeightSteps := 1 / Length(Moves) * 0.25;

  Result := WeightScore + WeightSteps + WeightSnake + WeightMoves;
end;

function TGameTry.GetFitnessSnake: Double;
var
  P: TPoint;
  HorizDir: Integer;
  Sequence: Integer;
  HighestValue: Integer;
begin
  HighestValue := Game.Board.GetHighestTileValue;
  Sequence := (Game.Board.Size.X * Game.Board.Size.Y);
  Result := 0;
  P := Point(Game.Board.Size.X, Game.Board.Size.Y - 1);
  HorizDir := -1;
  while (P.Y >= 0) do begin
    if ((P.X + HorizDir) < 0) or ((P.X + HorizDir) > (Game.Board.Size.X - 1)) then begin
      HorizDir := -HorizDir;
      Dec(P.Y);
      if P.Y < 0 then Break;
    end else Inc(P.X, HorizDir);
    if Game.Board.Tiles[P.Y, P.X].Value <> 0 then begin
      Result := Result + (Game.Board.Tiles[P.Y, P.X].Value / HighestValue) *
      (Sequence / (Game.Board.Size.X * Game.Board.Size.Y));
    end;
    Dec(Sequence);
  end;
  Result := Result / (Game.Board.Size.X * Game.Board.Size.Y);
end;

constructor TGameTry.Create;
begin
  Game := TGame.Create;
end;

destructor TGameTry.Destroy;
begin
  FreeAndNil(Game);
  inherited;
end;

procedure TGameTry.Assign(Source: TGameTry);
var
  I: Integer;
begin
  Game.Assign(Source.Game);
  SetLength(Moves, Length(Source.Moves));
  for I := 0 to Length(Moves) - 1 do
    Moves[I] := Source.Moves[I];
end;

{ TFormComputer }

procedure TFormComputer.FormClose(Sender: TObject; var CloseAction: TCloseAction
  );
begin
  ButtonStopClick(Self);
  Core.PersistentForm1.Save(Self);
end;

function GameCompareScore(const Item1, Item2: TGameTry): Integer;
var
  Score1: Double;
  Score2: Double;
begin
  Score1 := Item1.GetFitness;
  Score2 := Item2.GetFitness;
  if Score1 > Score2 then Result := -1
  else if Score1 < Score2 then Result := 1
  else Result := 0;
end;

procedure TFormComputer.ButtonStartClick(Sender: TObject);
var
  NewTry: TGameTry;
  S: string;
  I: Integer;
  J: Integer;
  GameTries: TGameTries;
begin
  ButtonStart.Enabled := False;
  ButtonStop.Enabled := True;
  Stop := False;
  with Core.Game do begin
    while CanMove and not Stop do begin
      NewTry := TGameTry.Create;
      NewTry.Game.Assign(Core.Game);
      GameTries1.Clear;
      TryAllDirections(GameTries1, NewTry);
      FreeAndNil(NewTry);
      GameTries2.Clear;
      for I := 0 to GameTries1.Count - 1 do
        TryAllDirections(GameTries2, GameTries1[I]);
      GameTries3.Clear;
      for I := 0 to GameTries2.Count - 1 do
        TryAllDirections(GameTries3, GameTries2[I]);
      GameTries4.Clear;
      for I := 0 to GameTries3.Count - 1 do
        TryAllDirections(GameTries4, GameTries3[I]);

      GameTries := GameTries4;
      GameTries.Sort(GameCompareScore);
      S := '';
      for I := 0 to GameTries.Count - 1 do begin
        S := S + FormatFloat('0.000', GameTries[I].GetFitness) + '(';
        for J := 0 to Length(GameTries[I].Moves) - 1 do
          S := S + DirectionText[GameTries[I].Moves[J]] + ' ';
        S := S + '), ';
      end;
      MoveAllAndUpdate(GameTries[0].Moves[0], False);
{      if CanMergeDirection(drDown) then MoveAllAnimate(drDown)
      else if CanMergeDirection(drRight) then MoveAllAnimate(drRight)
      else if CanMergeDirection(drLeft) then MoveAllAnimate(drLeft)
      else if CanMoveDirection(drDown) then MoveAllAnimate(drDown)
      else if CanMoveDirection(drRight) then MoveAllAnimate(drRight)
      else if CanMoveDirection(drLeft) then MoveAllAnimate(drLeft)
      else if CanMoveDirection(drUp) then MoveAllAnimate(drUp)
      else Break;
      }
      Application.ProcessMessages;
      Sleep(TrackBar1.Position);
    end;
  end;
  ButtonStart.Enabled := True;
  ButtonStop.Enabled := False;
end;

procedure TFormComputer.ButtonStopClick(Sender: TObject);
begin
  Stop := True;
end;

procedure TFormComputer.FormCreate(Sender: TObject);
begin
  Core.Translator1.TranslateComponentRecursive(Self);
  Core.ThemeManager1.UseTheme(Self);
  GameTries1 := TGameTries.Create;
  GameTries2 := TGameTries.Create;
  GameTries3 := TGameTries.Create;
  GameTries4 := TGameTries.Create;
end;

procedure TFormComputer.FormDestroy(Sender: TObject);
begin
  FreeAndNil(GameTries1);
  FreeAndNil(GameTries2);
  FreeAndNil(GameTries3);
  FreeAndNil(GameTries4);
end;

procedure TFormComputer.FormShow(Sender: TObject);
begin
  Core.PersistentForm1.Load(Self);
end;

procedure TFormComputer.TryAllDirections(GameTries: TGameTries; GameTry: TGameTry);
var
  Direction: TMoveDirection;
  NewTry: TGameTry;
begin
  for Direction := drLeft to drDown do begin
    if GameTry.Game.CanMoveDirection(Direction) then begin
      NewTry := TGameTry.Create;
      NewTry.Assign(GameTry);
      NewTry.Game.UndoEnabled := False;
      NewTry.Game.AnimationDuration := 0;
      NewTry.Game.MoveAll(Direction, False);
      SetLength(NewTry.Moves, Length(NewTry.Moves) + 1);
      NewTry.Moves[Length(NewTry.Moves) - 1] := Direction;
      GameTries.Add(NewTry);
    end;
  end;
end;

end.