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