1 | unit FormComputer;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
|
---|
7 | Game, Generics.Collections, Generics.Defaults, FormEx;
|
---|
8 |
|
---|
9 | type
|
---|
10 | { TGameTry }
|
---|
11 |
|
---|
12 | TGameTry = class
|
---|
13 | Game: TGame;
|
---|
14 | Moves: array of TMoveDirection;
|
---|
15 | constructor Create;
|
---|
16 | destructor Destroy; override;
|
---|
17 | procedure Assign(Source: TGameTry);
|
---|
18 | private
|
---|
19 | function GetFitness: Double;
|
---|
20 | function GetFitnessSnake: Double;
|
---|
21 | end;
|
---|
22 |
|
---|
23 | TGameTries = class(TObjectList<TGameTry>)
|
---|
24 | end;
|
---|
25 |
|
---|
26 | { TGameTryComparer }
|
---|
27 |
|
---|
28 | TGameTryComparer = class(TInterfacedObject, IComparer<TGameTry>)
|
---|
29 | function Compare(constref Left, Right: TGameTry): Integer; overload;
|
---|
30 | end;
|
---|
31 |
|
---|
32 | { TFormComputer }
|
---|
33 |
|
---|
34 | TFormComputer = class(TFormEx)
|
---|
35 | ButtonStart: TButton;
|
---|
36 | ButtonEnd: TButton;
|
---|
37 | ButtonStep: TButton;
|
---|
38 | Label1: TLabel;
|
---|
39 | TrackBar1: TTrackBar;
|
---|
40 | procedure ButtonStartClick(Sender: TObject);
|
---|
41 | procedure ButtonEndClick(Sender: TObject);
|
---|
42 | procedure ButtonStepClick(Sender: TObject);
|
---|
43 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
---|
44 | procedure FormCreate(Sender: TObject);
|
---|
45 | procedure FormDestroy(Sender: TObject);
|
---|
46 | private
|
---|
47 | Running: Boolean;
|
---|
48 | GameTries1: TGameTries;
|
---|
49 | GameTries2: TGameTries;
|
---|
50 | GameTries3: TGameTries;
|
---|
51 | GameTries4: TGameTries;
|
---|
52 | procedure Step;
|
---|
53 | procedure TryAllDirections(GameTries: TGameTries; GameTry: TGameTry);
|
---|
54 | procedure UpdateInterface;
|
---|
55 | end;
|
---|
56 |
|
---|
57 |
|
---|
58 | implementation
|
---|
59 |
|
---|
60 | {$R *.lfm}
|
---|
61 |
|
---|
62 | uses
|
---|
63 | Core;
|
---|
64 |
|
---|
65 | { TGameTry }
|
---|
66 |
|
---|
67 | function TGameTry.GetFitness: Double;
|
---|
68 | const
|
---|
69 | DirWeight: array[TMoveDirection] of Double = (0, 0.25, -10000, 0.5, 0.75);
|
---|
70 | var
|
---|
71 | I: Integer;
|
---|
72 | WeightSnake: Double;
|
---|
73 | WeightMoves: Double;
|
---|
74 | WeightScore: Double;
|
---|
75 | WeightSteps: Double;
|
---|
76 | begin
|
---|
77 | WeightSnake := 1000 * GetFitnessSnake;
|
---|
78 |
|
---|
79 | WeightMoves := 0;
|
---|
80 | for I := 0 to Length(Moves) - 1 do
|
---|
81 | WeightMoves := WeightMoves + DirWeight[Moves[I]];
|
---|
82 | WeightMoves := WeightMoves / Length(Moves);
|
---|
83 |
|
---|
84 | WeightScore := 100 * Game.Score / Game.Board.GetValueSum;
|
---|
85 | WeightSteps := 1 / Length(Moves) * 0.25;
|
---|
86 |
|
---|
87 | Result := WeightScore + WeightSteps + WeightSnake + WeightMoves;
|
---|
88 | end;
|
---|
89 |
|
---|
90 | function TGameTry.GetFitnessSnake: Double;
|
---|
91 | var
|
---|
92 | P: TPoint;
|
---|
93 | HorizDir: Integer;
|
---|
94 | Sequence: Integer;
|
---|
95 | HighestValue: Integer;
|
---|
96 | begin
|
---|
97 | HighestValue := Game.Board.GetHighestTileValue;
|
---|
98 | Sequence := (Game.Board.Size.X * Game.Board.Size.Y);
|
---|
99 | Result := 0;
|
---|
100 | P := Point(Game.Board.Size.X, Game.Board.Size.Y - 1);
|
---|
101 | HorizDir := -1;
|
---|
102 | while (P.Y >= 0) do begin
|
---|
103 | if ((P.X + HorizDir) < 0) or ((P.X + HorizDir) > (Game.Board.Size.X - 1)) then begin
|
---|
104 | HorizDir := -HorizDir;
|
---|
105 | Dec(P.Y);
|
---|
106 | if P.Y < 0 then Break;
|
---|
107 | end else Inc(P.X, HorizDir);
|
---|
108 | if Game.Board.Tiles[P.Y, P.X].Value <> 0 then begin
|
---|
109 | Result := Result + (Game.Board.Tiles[P.Y, P.X].Value / HighestValue) *
|
---|
110 | (Sequence / (Game.Board.Size.X * Game.Board.Size.Y));
|
---|
111 | end;
|
---|
112 | Dec(Sequence);
|
---|
113 | end;
|
---|
114 | Result := Result / (Game.Board.Size.X * Game.Board.Size.Y);
|
---|
115 | end;
|
---|
116 |
|
---|
117 | constructor TGameTry.Create;
|
---|
118 | begin
|
---|
119 | Game := TGame.Create;
|
---|
120 | end;
|
---|
121 |
|
---|
122 | destructor TGameTry.Destroy;
|
---|
123 | begin
|
---|
124 | FreeAndNil(Game);
|
---|
125 | inherited;
|
---|
126 | end;
|
---|
127 |
|
---|
128 | procedure TGameTry.Assign(Source: TGameTry);
|
---|
129 | var
|
---|
130 | I: Integer;
|
---|
131 | begin
|
---|
132 | Game.Assign(Source.Game);
|
---|
133 | SetLength(Moves, Length(Source.Moves));
|
---|
134 | for I := 0 to Length(Moves) - 1 do
|
---|
135 | Moves[I] := Source.Moves[I];
|
---|
136 | end;
|
---|
137 |
|
---|
138 | { TGameTryComparer }
|
---|
139 |
|
---|
140 | function TGameTryComparer.Compare(constref Left, Right: TGameTry): Integer;
|
---|
141 | var
|
---|
142 | ScoreLeft: Double;
|
---|
143 | ScoreRight: Double;
|
---|
144 | begin
|
---|
145 | ScoreLeft := Left.GetFitness;
|
---|
146 | ScoreRight := Right.GetFitness;
|
---|
147 | if ScoreLeft > ScoreRight then Result := -1
|
---|
148 | else if ScoreLeft < ScoreRight then Result := 1
|
---|
149 | else Result := 0;
|
---|
150 | end;
|
---|
151 |
|
---|
152 | { TFormComputer }
|
---|
153 |
|
---|
154 | procedure TFormComputer.FormClose(Sender: TObject; var CloseAction: TCloseAction
|
---|
155 | );
|
---|
156 | begin
|
---|
157 | Running := False;
|
---|
158 | end;
|
---|
159 |
|
---|
160 | function GameCompareScore(const Item1, Item2: TGameTry): Integer;
|
---|
161 | var
|
---|
162 | Score1: Double;
|
---|
163 | Score2: Double;
|
---|
164 | begin
|
---|
165 | Score1 := Item1.GetFitness;
|
---|
166 | Score2 := Item2.GetFitness;
|
---|
167 | if Score1 > Score2 then Result := -1
|
---|
168 | else if Score1 < Score2 then Result := 1
|
---|
169 | else Result := 0;
|
---|
170 | end;
|
---|
171 |
|
---|
172 | procedure TFormComputer.ButtonStartClick(Sender: TObject);
|
---|
173 | begin
|
---|
174 | Running := True;
|
---|
175 | while Core.Core.Game.CanMove and Running do begin
|
---|
176 | Step;
|
---|
177 | end;
|
---|
178 | Running := False;
|
---|
179 | end;
|
---|
180 |
|
---|
181 | procedure TFormComputer.ButtonEndClick(Sender: TObject);
|
---|
182 | begin
|
---|
183 | Running := False;
|
---|
184 | end;
|
---|
185 |
|
---|
186 | procedure TFormComputer.ButtonStepClick(Sender: TObject);
|
---|
187 | begin
|
---|
188 | Step;
|
---|
189 | end;
|
---|
190 |
|
---|
191 | procedure TFormComputer.FormCreate(Sender: TObject);
|
---|
192 | begin
|
---|
193 | GameTries1 := TGameTries.Create;
|
---|
194 | GameTries2 := TGameTries.Create;
|
---|
195 | GameTries3 := TGameTries.Create;
|
---|
196 | GameTries4 := TGameTries.Create;
|
---|
197 | UpdateInterface;
|
---|
198 | end;
|
---|
199 |
|
---|
200 | procedure TFormComputer.FormDestroy(Sender: TObject);
|
---|
201 | begin
|
---|
202 | FreeAndNil(GameTries1);
|
---|
203 | FreeAndNil(GameTries2);
|
---|
204 | FreeAndNil(GameTries3);
|
---|
205 | FreeAndNil(GameTries4);
|
---|
206 | end;
|
---|
207 |
|
---|
208 | procedure TFormComputer.Step;
|
---|
209 | var
|
---|
210 | NewTry: TGameTry;
|
---|
211 | S: string;
|
---|
212 | I: Integer;
|
---|
213 | J: Integer;
|
---|
214 | GameTries: TGameTries;
|
---|
215 | GameTryComparer: TGameTryComparer;
|
---|
216 | Delay: Integer;
|
---|
217 | begin
|
---|
218 | with Core.Core.Game do begin
|
---|
219 | NewTry := TGameTry.Create;
|
---|
220 | NewTry.Game.Assign(Core.Core.Game);
|
---|
221 | GameTries1.Clear;
|
---|
222 | TryAllDirections(GameTries1, NewTry);
|
---|
223 | FreeAndNil(NewTry);
|
---|
224 | GameTries2.Clear;
|
---|
225 | for I := 0 to GameTries1.Count - 1 do
|
---|
226 | TryAllDirections(GameTries2, GameTries1[I]);
|
---|
227 | GameTries3.Clear;
|
---|
228 | for I := 0 to GameTries2.Count - 1 do
|
---|
229 | TryAllDirections(GameTries3, GameTries2[I]);
|
---|
230 | GameTries4.Clear;
|
---|
231 | for I := 0 to GameTries3.Count - 1 do
|
---|
232 | TryAllDirections(GameTries4, GameTries3[I]);
|
---|
233 |
|
---|
234 | GameTries := GameTries4;
|
---|
235 | GameTryComparer := TGameTryComparer.Create;
|
---|
236 | GameTries.Sort(GameTryComparer);
|
---|
237 | S := '';
|
---|
238 | for I := 0 to GameTries.Count - 1 do begin
|
---|
239 | S := S + FormatFloat('0.000', GameTries[I].GetFitness) + '(';
|
---|
240 | for J := 0 to Length(GameTries[I].Moves) - 1 do
|
---|
241 | S := S + DirectionText[GameTries[I].Moves[J]] + ' ';
|
---|
242 | S := S + '), ';
|
---|
243 | end;
|
---|
244 | MoveAllAndUpdate(GameTries[0].Moves[0], False);
|
---|
245 | { if CanMergeDirection(drDown) then MoveAllAnimate(drDown)
|
---|
246 | else if CanMergeDirection(drRight) then MoveAllAnimate(drRight)
|
---|
247 | else if CanMergeDirection(drLeft) then MoveAllAnimate(drLeft)
|
---|
248 | else if CanMoveDirection(drDown) then MoveAllAnimate(drDown)
|
---|
249 | else if CanMoveDirection(drRight) then MoveAllAnimate(drRight)
|
---|
250 | else if CanMoveDirection(drLeft) then MoveAllAnimate(drLeft)
|
---|
251 | else if CanMoveDirection(drUp) then MoveAllAnimate(drUp)
|
---|
252 | else Break;
|
---|
253 | }
|
---|
254 | Delay := TrackBar1.Position;
|
---|
255 | while Delay > 0 do begin
|
---|
256 | Application.ProcessMessages;
|
---|
257 | Sleep(10);
|
---|
258 | Delay := Delay - 10;
|
---|
259 | end;
|
---|
260 | end;
|
---|
261 | UpdateInterface;
|
---|
262 | end;
|
---|
263 |
|
---|
264 | procedure TFormComputer.TryAllDirections(GameTries: TGameTries; GameTry: TGameTry);
|
---|
265 | var
|
---|
266 | Direction: TMoveDirection;
|
---|
267 | NewTry: TGameTry;
|
---|
268 | begin
|
---|
269 | for Direction := drLeft to drDown do begin
|
---|
270 | if GameTry.Game.CanMoveDirection(Direction) then begin
|
---|
271 | NewTry := TGameTry.Create;
|
---|
272 | NewTry.Assign(GameTry);
|
---|
273 | NewTry.Game.UndoEnabled := False;
|
---|
274 | NewTry.Game.AnimationDuration := 0;
|
---|
275 | NewTry.Game.MoveAll(Direction, False);
|
---|
276 | SetLength(NewTry.Moves, Length(NewTry.Moves) + 1);
|
---|
277 | NewTry.Moves[Length(NewTry.Moves) - 1] := Direction;
|
---|
278 | GameTries.Add(NewTry);
|
---|
279 | end;
|
---|
280 | end;
|
---|
281 | end;
|
---|
282 |
|
---|
283 | procedure TFormComputer.UpdateInterface;
|
---|
284 | begin
|
---|
285 | ButtonStart.Enabled := not Running;
|
---|
286 | ButtonStep.Enabled := not Running;
|
---|
287 | ButtonEnd.Enabled := Running;
|
---|
288 | end;
|
---|
289 |
|
---|
290 | end.
|
---|
291 |
|
---|