From 9064a9de55326a9c4a224758d0f689c8cb98d4a4 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 15 May 2026 10:34:47 +0200 Subject: =?UTF-8?q?=D0=97=D0=B0=D0=BA=D0=BE=D0=BD=D1=87=D0=B8=D0=BB=20?= =?UTF-8?q?=D1=81=D0=BE=D0=BA=D0=BE=D0=B1=D0=B0=D0=BD=20=D0=B8=D0=B7=207-?= =?UTF-8?q?=D0=B9=20=D0=B3=D0=BB=D0=B0=D0=B2=D1=8B,=20=D1=87=D0=B5=D1=82?= =?UTF-8?q?=D0=B2=D0=B5=D1=80=D1=82=D0=BE=D0=B3=D0=BE=20=D1=83=D0=BF=D1=80?= =?UTF-8?q?=D0=B0=D0=B6=D0=BD=D0=B5=D0=BD=D0=B8=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../7/4_solver/states.pas" | 277 +++++++++++++++++++++ 1 file changed, 277 insertions(+) create mode 100644 "\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/4_solver/states.pas" (limited to 'Занимательное программирование/7/4_solver/states.pas') diff --git "a/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/4_solver/states.pas" "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/7/4_solver/states.pas" new file mode 100644 index 0000000..3dbcc00 --- /dev/null +++ "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/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; + 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. + -- cgit v1.2.3