1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
unit Problems;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, States;
function GetNeighbours(AState: TState): TStates;
function Search(InitialState: TState): TStates;
{ Можно ли передвинуть камень в указанном направлении. }
function CanPush(Element, Delta: TPosition; Walls, Boulders: TPositions): Boolean;
function IsGoal(ANode: TNode): Boolean;
function AtSomePosition(Needle: TPosition; Heap: TPositions): Boolean;
{ Дистанция между двумя позициями не учитывая стен. }
function ManhattanDistance(A, B: TPosition): Integer;
function CalculateHeuristic(AState: TState): Integer;
function ReconstructPath(CameFrom: TNode): TStates;
implementation
function GetNeighbours(AState: TState): TStates;
const
{ Вниз, вверх, вправо, влево. }
Moves: array[1..4] of TPosition = (
(X: 0; Y: 1),
(X: 0; Y: -1),
(X: 1; Y: 0),
(X: -1; Y: 0)
);
var
NewState: TState;
NewPosition, Move, Boulder: TPosition;
begin
Result := TStates.Create;
for Move in Moves do
begin
NewPosition.X := AState.Agent.X + Move.X;
NewPosition.Y := AState.Agent.Y + Move.Y;
if IsFree(NewPosition, AState.Walls) then
begin
NewState := TState.Create(AState, NewPosition);
{ Если можно передвинуть камень, добавляем новую позицию камня.
Иначе, оставляем камень на месте. }
for Boulder in AState.Boulders do
if Boulder = NewPosition then
if CanPush(Boulder, Move, AState.Walls, AState.Boulders) then
NewState.AddBoulder(Boulder.X + Move.X, Boulder.Y + Move.Y)
else
begin
FreeAndNil(NewState);
break
end
else
NewState.AddBoulder(Boulder.X, Boulder.Y);
if NewState <> nil then
begin
SetLength(Result, Length(Result) + 1);
Result[High(Result)] := NewState
end
end
end
end;
function CanPush(Element, Delta: TPosition; Walls, Boulders: TPositions): Boolean;
var
NewPosition: TPosition;
begin
NewPosition.X := Element.X + Delta.X;
NewPosition.Y := Element.Y + Delta.Y;
Result := IsFree(NewPosition, Walls) and IsFree(NewPosition, Boulders)
end;
function IsGoal(ANode: TNode): Boolean;
var
CurrentPlace: TPosition;
begin
Result := true;
for CurrentPlace in ANode.State.Places do
begin
Result := AtSomePosition(CurrentPlace, ANode.State.Boulders);
if not Result then
Exit
end
end;
function Search(InitialState: TState): TStates;
var
Frontier: TPriorityQueue;
Heuristics, i: Integer;
NextState, CurrentState: TState;
NextNode, CurrentNode: TNode;
Neighbours: TStates;
Visited: TStates;
begin
Visited := TStates.Create;
Result := TStates.Create;
Frontier := TPriorityQueue.Create;
try
Heuristics := CalculateHeuristic(initialState);
{ Создаем начало графа. }
NextState := TState.Create(InitialState);
NextNode := TNode.Create(NextState, nil, 0, Heuristics);
Frontier.Add(NextNode);
while not Frontier.IsEmpty do
begin
Heuristics := Frontier.Count;
CurrentNode := Frontier.Poll;
SetLength(Visited, Length(Visited) + 1);
Visited[High(Visited)] := CurrentNode.State;
if IsGoal(CurrentNode) then
begin
Result := ReconstructPath(CurrentNode);
Exit
end;
Neighbours := GetNeighbours(CurrentNode.State);
for i := 0 to High(Neighbours) do
begin
NextState := Neighbours[i];
for CurrentState in Visited do
if CurrentState.Compare(NextState) then
begin
FreeAndNil(NextState);
break
end;
if NextState <> nil then
begin
Heuristics := CalculateHeuristic(NextState);
NextNode := TNode.Create(NextState, CurrentNode, CurrentNode.Cost + 1, Heuristics);
Frontier.Add(NextNode)
end
end
end
finally
FreeAndNil(Frontier)
end;
end;
function AtSomePosition(Needle: TPosition; Heap: TPositions): Boolean;
var
CurrentPosition: TPosition;
begin
Result := false;
for CurrentPosition in Heap do
if CurrentPosition = Needle then
begin
Result := true;
Exit
end
end;
function ManhattanDistance(A, B: TPosition): Integer;
begin
Result := Abs(A.X - B.X) + Abs(A.Y - B.Y)
end;
function CalculateHeuristic(AState: TState): Integer;
var
CurrentPlace, CurrentBoulder: TPosition;
Distance, MinimalDistance: Integer;
begin
Result := 0;
for CurrentBoulder in AState.Boulders do
begin
MinimalDistance := Integer.MaxValue;
for CurrentPlace in AState.Places do
begin
Distance := ManhattanDistance(CurrentBoulder, CurrentPlace);
if (not AtSomePosition(CurrentPlace, AState.Boulders)) and (Distance < MinimalDistance) then
MinimalDistance := Distance
end;
Inc(Result, MinimalDistance)
end
end;
function ReconstructPath(CameFrom: TNode): TStates;
var
Temporary: TState;
CurrentLength, CurrentSegment: Integer;
begin
Result := TStates.Create;
CurrentLength := 0;
while CameFrom <> nil do
begin
SetLength(Result, CurrentLength + 1);
Result[CurrentLength] := TState.Create(CameFrom.State);
CameFrom := CameFrom.Node;
Inc(CurrentLength)
end;
Dec(CurrentLength);
CurrentSegment := 0;
while CurrentSegment < CurrentLength do
begin
Temporary := Result[CurrentSegment];
Result[CurrentSegment] := Result[CurrentLength];
Result[CurrentLength] := Temporary;
Dec(CurrentLength);
Inc(CurrentSegment)
end
end;
end.
|
