diff options
| author | Eugen Wissner <belka@caraus.de> | 2026-05-15 10:34:47 +0200 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2026-05-15 10:34:47 +0200 |
| commit | 9064a9de55326a9c4a224758d0f689c8cb98d4a4 (patch) | |
| tree | 6077a94cb989dd482f50990633a98f9448b5b54c /Занимательное программирование/7/4_solver/states.pas | |
| parent | ee8f910cb0a2761d77a13fb4423a157a6d64b19c (diff) | |
| download | book-exercises-master.tar.gz | |
Diffstat (limited to 'Занимательное программирование/7/4_solver/states.pas')
| -rw-r--r-- | Занимательное программирование/7/4_solver/states.pas | 277 |
1 files changed, 277 insertions, 0 deletions
diff --git a/Занимательное программирование/7/4_solver/states.pas b/Занимательное программирование/7/4_solver/states.pas new file mode 100644 index 0000000..3dbcc00 --- /dev/null +++ b/Занимательное программирование/7/4_solver/states.pas @@ -0,0 +1,277 @@ +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.
+
|