请求帮助:下面delphi代码中的算法是什么?
{ Comment out the following $DEFINE line to get a
worst case scenario: The field is sorted like this:
8 7 6
5 4 3
2 1
The computer solves this board in 30 moves,
but the implemented algorithm needs a long time
(about 14 minutes on my PII-233).
During this time, it evaluated 17848 moves and there were
7810 more to go.
}
//{$DEFINE WORSTCASE}
{ Just kidding when I said the above was worst case.
Now this one is *really* bad. Not only the board is
sorted upside down, but there are to pieces exchanged:
7 8 6
5 4 3
2 1
You cannot solve boards like this, which was proven by Rick
Wilson in 1974. }
//{$DEFINE NOSOLVE}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, moves, ComCtrls, Menus, solver;
type
TMode=(mdIdle,mdOneStep,mdFullSolve);
TForm1 = class(TForm)
Panel3: TPanel;
Panel4: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
DaTei1: TMenuItem;
NeuesSpiel1: TMenuItem;
N1: TMenuItem;
NaechsterZug1: TMenuItem;
Loesen1: TMenuItem;
N2: TMenuItem;
Beenden1: TMenuItem;
Timer1: TTimer;
Hilfe1: TMenuItem;
Info1: TMenuItem;
View1: TMenuItem;
Progress1: TMenuItem;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Beenden1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure NeuesSpiel1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Loesen1Click(Sender: TObject);
procedure NaechsterZug1Click(Sender: TObject);
procedure Info1Click(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Progress1Click(Sender: TObject);
private
{ Private-Deklarationen }
BButton: Array[0..8] of TButton;
TheMove: TMove;
leer, computerMoves, userMoves: Integer;
solve: TSolver;
solveValid: Boolean;
Mode: TMode;
procedure ShowBoard(m: TMove);
procedure EnableField(val: Boolean);
procedure ValidateSolve;
procedure SolveTerminated(Sender: TObject);
procedure CancelSolve(Sender: TObject);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses progress;
{$R *.DFM}
procedure TForm1.Button2Click(Sender: TObject);
var Knopf: Integer;
begin
knopf:=(Sender As TButton).Tag;
// Erlaubten Zug durchf黨ren...
if((Abs(leer Mod 3-knopf Mod 3)+Abs(leer Div 3-knopf Div 3))=1) Then
Begin
TheMove.Board[leer]:=TheMove.Board[knopf];
TheMove.Board[knopf]:=0;
leer:=knopf;
Inc(userMoves);
ShowBoard(TheMove);
solveValid:=False;
End;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
b: TBoard;
begin
BButton[0]:=Button1;
BButton[1]:=Button2;
BButton[2]:=Button3;
BButton[3]:=Button4;
BButton[4]:=Button5;
BButton[5]:=Button6;
BButton[6]:=Button7;
BButton[7]:=Button8;
BButton[8]:=Button9;
For i:=1 To 9 Do b[i-1]:=9-i;
{$IFDEF NOSOLVE}
b[0]:=7;
b[1]:=8;
{$ENDIF}
TheMove:=TMove.Create(b);
{$IFDEF WORSTCASE}
ShowBoard(TheMove);
{$ELSE}
NeuesSpiel1Click(Self);
{$ENDIF}
solve:=TSolver.Create;
solveValid:=False;
end;
procedure TForm1.ShowBoard(m: TMove);
var i: Integer;
Begin
For i:=0 To 8 Do
If m.Board[i]<>0 Then
Begin
BButton[i].Caption:=IntToStr(m.Board[i]);
BButton[i].Visible:=True;
End Else
Begin
BButton[i].Visible:=False;
leer:=i;
End;
If m.isSolve Then StatusBar1.SimpleText:='Position solved in '+IntToStr(userMoves)+' move(s).'
Else StatusBar1.SimpleText:='Move: '+IntToStr(userMoves);
End;
procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if(computerMoves<Solve.Steps.Count) Then
Begin
TheMove.Free;
TheMove:=TMove.Create(TMove(Solve.Steps.Items[computerMoves]).Board);
ShowBoard(TheMove);
StatusBar1.SimpleText:=IntToStr(computerMoves+1)+'/'+ IntToStr(Solve.Steps.Count);
Inc(computerMoves);
End;
if(computerMoves>=Solve.Steps.Count) Then
Begin
Timer1.Enabled:=False;
EnableField(True);
End;
end;
Procedure TForm1.EnableField(val: Boolean);
Begin
Panel4.Enabled:=val;
NeuesSPiel1.Enabled:=Val;
Loesen1.Enabled:=Val;
NaechsterZug1.Enabled:=Val;
Progress1.Enabled:=Val;
End;
procedure TForm1.NeuesSpiel1Click(Sender: TObject);
var i: Integer;
move1, move2: TMove;
begin
move1:=TheMove;
Randomize;
For I:=0 to 1000 Do
Begin
move2:=move1.GetNext(Round(Random(move1.NextCount)));
move1.Free;
move1:=move2;
End;
TheMove:=move1;
ShowBoard(TheMove);
solveValid:=False;
userMoves:=0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
solve.Suspend;
solve.Terminate;
solve.Free;
TheMove.Free;
end;
procedure TForm1.Loesen1Click(Sender: TObject);
begin
Mode:=mdFullSolve;
If not solveValid Then ValidateSolve Else Timer1.Enabled:=True;
end;
Procedure TForm1.ValidateSolve;
Begin
If solveValid then SolveTerminated(Self)
Else Begin
Solve.Free;
Solve:=TSolver.Create;
TheMove.Tiefe:=0;
solve.Start:=TheMove;
solve.OnTerminate:=SolveTerminated;
EnableField(False);
StatusBar1.SimpleText:='Please wait...';
Form2.OnCancel:=CancelSolve;
If Progress1.Checked Then
Begin
Form2.SHow;
solve.EvalLabel:=Form2.Label5;
solve.OpenLabel:=Form2.Label3;
End;
solve.DoInfo:=Progress1.Checked;
solve.Resume;
End;
End;
procedure TForm1.NaechsterZug1Click(Sender: TObject);
begin
Mode:=mdOneStep;
if not solveValid Then ValidateSolve Else Timer1Timer(Self);
end;
procedure TForm1.Info1Click(Sender: TObject);
begin
ShowMessage('The Slider Game v1.1'+#13+
'Copyright (c) 1998,2001 X-Watch Software Sven K黱zler'+#13+
'Please see documentation or source code for license terms.'+#13+#13+
'Heuristic written by Geert-Jan van Opdorp,'+#13+
'Copyright (c) 1995 AI Engineering.');
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
If Key=#27 Then
Begin
Timer1.Enabled:=False;
EnableField(True);
Key:=#0;
End;
end;
procedure TForm1.SolveTerminated(Sender: TObject);
Begin
StatusBar1.SimpleText:='';
EnableField(True);
computerMoves:=0;
Form2.OnCancel:=nil;
if solve.Found=sfYes Then
Begin
solveValid:=True;
If (Solve.Steps.Count>0) Then
Begin
If Mode=mdFullSolve Then
Begin
EnableField(False);
Timer1.Enabled:=True;
End Else If Mode=mdOneStep Then Timer1Timer(Self);
End
End;
if solve.Found=sfNo Then StatusBar1.SimpleText:='Cannot solve position.';
if solve.Found=sfBreak Then StatusBar1.SimpleText:='Break requested.';
Form2.StopProgress;
End;
procedure TForm1.Progress1Click(Sender: TObject);
begin
Progress1.Checked:=Not Progress1.Checked;
end;
Procedure TForm1.CancelSolve(Sender: TOBject);
Begin
if not solve.Terminated Then
begin
solve.Suspend;
solve.Terminate;
solveValid:=False;
EnableField(True);
StatusBar1.SimpleText:='Break requested.';
end;
End;
end.
