path: root/Занимательное программирование/7/4_solver/states.pas

unit States;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, fgl;

type
  TPosition = record
    X, Y: Integer
  end;
  TPositions = array of TPosition;

  TState = class
  private
    PAgent: TPosition;
    PWalls, PPlaces, PBoulders: TPositions;

    procedure CopyArrays(AState: TState);

  public
    constructor Create;
    constructor Create(ASTate: TState; AAgent: TPosition);
    constructor Create(ASTate: TState);

    property Walls: TPositions read PWalls;
    property Places: TPositions read PPlaces;
    property Boulders: TPositions read PBoulders;
    property Agent: TPosition read PAgent write PAgent;

    procedure AddWall(AX, AY: Integer);
    procedure AddPlace(AX, AY: Integer);
    procedure AddBoulder(AX, AY: Integer);
    procedure SetAgent(AX, AY: Integer);
    function Compare(AState: TState): Boolean;
  end;
  TStates = array of TState;

  TBoard = class
  private
    PWidth, PHeight: Integer;
    PInitialState: TState;

  public
    property Width: Integer read PWidth;
    property Height: Integer read PHeight;
    property InitialState: TState read PInitialState;

    constructor Create(AWidth, AHeight: Integer; AInitialState: TState);
    destructor Destroy; override;
  end;

  INode = interface
    function GetTotalCost: Integer;
  end;

  TNode = class(TInterfacedObject, INode)
  private
    PState: TState;
    PNode: TNode;
    PCost, Heuristic: Integer;
  public
    property State: TState read PState;
    property Node: TNode read PNode;
    property Cost: Integer read PCost;

    constructor Create(AState: TState; ANode: TNode; ACost, AHeuristic: Integer);
    destructor Destroy;

    function GetTotalCost: Integer;
  end;
  TNodes = array of TNode;

  TNodeList = specialize TFPGList<TNode>;
  TPriorityQueue = class
  private
    Nodes: TNodeList;

  public
    constructor Create;

    procedure Add(ANode: TNode);
    function Poll: TNode;
    function IsEmpty: Boolean;
    function Count: Integer;
  end;

  operator = (P1, P2: TPosition) B: Boolean;

  function IsFree(NewPosition: TPosition; Walls: TPositions): Boolean;

implementation

procedure TSTate.CopyArrays(AState: TState);
begin
  PWalls := Copy(AState.Walls, 0, Length(ASTate.Walls));
  PPlaces := Copy(AState.Places, 0, Length(ASTate.Places))
end;

constructor TState.Create;
begin
end;

constructor TState.Create(ASTate: TState; AAgent: TPosition);
begin
  PAgent := AAgent;
  CopyArrays(AState);
  PBoulders := TPositions.Create
end;

constructor TState.Create(ASTate: TState);
begin
  PAgent := AState.Agent;
  CopyArrays(AState);
  PBoulders := Copy(AState.Boulders, 0, Length(AState.Boulders))
end;

procedure TState.AddWall(AX, AY: Integer);
var
  CurrentLength: Integer;
begin
  CurrentLength := Length(PWalls);
  SetLength(PWalls, CurrentLength + 1);

  PWalls[CurrentLength].X := AX;
  PWalls[CurrentLength].Y := AY
end;

procedure TState.AddPlace(AX, AY: Integer);
var
  CurrentLength: Integer;
begin
  CurrentLength := Length(PPlaces);
  SetLength(PPlaces, CurrentLength + 1);

  PPlaces[CurrentLength].X := AX;
  PPlaces[CurrentLength].Y := AY
end;

procedure TState.AddBoulder(AX, AY: Integer);
var
  CurrentLength: Integer;
begin
  CurrentLength := Length(PBoulders);
  SetLength(PBoulders, CurrentLength + 1);

  PBoulders[CurrentLength].X := AX;
  PBoulders[CurrentLength].Y := AY
end;

procedure TState.SetAgent(AX, AY: Integer);
begin
  PAgent.X := AX;
  PAgent.Y := AY
end;

function TState.Compare(AState: TState): Boolean;
var
  i: Integer;
begin
  Result := (Agent = AState.Agent)
      and (Length(Walls) = Length(AState.Walls))
      and (Length(Boulders) = Length(AState.Boulders))
      and (Length(Places) = Length(AState.Places));
  if not Result then
    Exit;
  for i := 0 to High(Walls) do
    if Walls[i] <> AState.Walls[i] then
    begin
      Result := false;
      Exit
    end;
  for i := 0 to High(Boulders) do
    if Boulders[i] <> AState.Boulders[i] then
    begin
      Result := false;
      Exit
    end;
  for i := 0 to High(Places) do
    if Places[i] <> AState.Places[i] then
    begin
      Result := false;
      Exit
    end
end;

constructor TBoard.Create(AWidth, AHeight: Integer; AInitialState: TState);
begin
  PWidth := AWidth;
  PHeight := AHeight;
  PInitialState := AInitialState
end;

destructor TBoard.Destroy;
begin
  PInitialState.Destroy;
  inherited
end;

constructor TNode.Create(AState: TState; ANode: TNode; ACost, AHeuristic: Integer);
begin
  PState := AState;
  PNode := ANode;
  PCost := ACost;
  Heuristic := AHeuristic
end;

destructor TNode.Destroy;
begin
  PState.Free;
  inherited
end;

function TNode.GetTotalCost: Integer;
begin
  Result := Cost + Heuristic
end;

constructor TPriorityQueue.Create;
begin
  Nodes := TNodeList.Create
end;

procedure TPriorityQueue.Add(ANode: TNode);
var
  Index, TotalCost: Integer;
  CurrentNode: TNode;
begin
  Index := 0;
  TotalCost := ANode.GetTotalCost;

  for CurrentNode in Nodes do
  begin
    if CurrentNode.getTotalCost >= TotalCost then
      break;
    Inc(Index)
  end;
  Nodes.Insert(Index, ANode)
end;

function TPriorityQueue.Poll: TNode;
begin
  Result := Nodes.Extract(Nodes.First)
end;

function TPriorityQueue.IsEmpty: Boolean;
begin
  Result := Count = 0
end;

function TPriorityQueue.Count: Integer;
begin
  Result := Nodes.Count
end;

operator = (P1, P2: TPosition) B: Boolean;
begin
  B := (P1.X = P2.X) and (P1.Y = P2.Y)
end;

function IsFree(NewPosition: TPosition; Walls: TPositions): Boolean;
var
  Wall: TPosition;
begin
  for Wall in Walls do
    if NewPosition = Wall then
    begin
      Result := false;
      Exit
    end;
  Result := true
end;

end.