A*算法实践录1
接触A*其实就是这个礼拜, 以前基本不知道.但是深度优先和广度优先还是知道一点点.其实以前在数据结构中就学过,只是没学明白 也没有机会应用和再学习,就淡忘了. 这是比较悲哀的事. 然而我现在有机会重新学习他们了.
对于这些理论的描述似乎已经没有意义. 因为网络上随处一搜都有很经典权威的诠释. 我只是想写下我接触A*的全过程, 以便我以后的学习. 作为我学习的积累,也希望能得到通道中朋友的指正,或者能给需要帮助的人一些启示.
好的.马上贴代码..
时间过得好快. .... 写出来的代码, 还是最基本的东西.. 贴出来.
有时间了再写心得.总结.
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids, ExtCtrls, Menus;
type
{节点定义 vG 代表某节点的G值， vH 代表某节点的H值。 A×中的F值通过vG+ vH 获得}
PGridNode = ^TGridNode;
TGridNode = record
Col: Integer;
Row: Integer;
vG : Integer; {vG 值 是节点到起始节点的距离}
vH : Integer; {vH 值 是节点到终结节点的距离}
Parent: PGridNode;
end;
TForm1 = class(TForm)
DrawGrid1: TDrawGrid;
Panel1: TPanel;
Panel2: TPanel;
BitBtn1: TBitBtn;
RadioGroup1: TRadioGroup;
Button1: TButton;
Panel3: TPanel;
Memo1: TMemo;
Button2: TButton;
procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Button2Click(Sender: TObject);
private
FDes, FSrc: PGridNode; {FDes是目标节点， 代表终点； FSrc是起始节点，代表起点。}
function GetMaxCol: integer;
function GetMaxRow: integer;
function GetptDes: PGridNode;
function GetptSrc: PGridNode;
procedure SetptDes(const Value: PGridNode);
procedure SetptSrc(const Value: PGridNode);
function IsExist(FList: TList; vNode: PGridNode): Boolean; overload;
function IsExist(FList: TList; Col, Row: Integer): Boolean; overload;
function IsExist(FList: TList; Col, Row: Integer; var pt: PGridNode): Boolean; overload;
{ Private declarations }
public
{ Public declarations }
Gred: array[0..9] of array[0..9] of Byte; {0: 空; 1: 障碍物; 2: 起点; 3: 目标}
pt: array of TPoint;
OpenList, CloseList: TList; {开启列表和关闭列表， 负责可搜索和已搜索节点}
Found : Boolean;
function Go(cDes,rDes,cSrc,rSrc: integer): Boolean;
function FindWithA: Boolean;
function GetMinF: PGridNode;
//function GetMinG:
procedure AddOpenList(pt: PGridNode);
procedure AddCloseList(pt: PGridNode);
function NextIsTrue(pt: PGridNode): Boolean;
procedure AddRoundToOpenList(pt: PGridNode);
procedure SetCountG(var Node: PGridNode);
procedure SetCountH(var Node: PGridNode);
procedure ClearList(var List: TList);
property ptDes: PGridNode read GetptDes write SetptDes;
property ptSrc: PGridNode read GetptSrc write SetptSrc; {以属性的形式 向外部提供起始和终结节点}
property MaxCol: Integer read GetMaxCol;
property MaxRow: Integer read GetMaxRow;
end;
var
Form1: TForm1;
implementation
uses StdConvs;
{$R *.dfm}
procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
CanSelect := False;
if Gred[ACol, ARow] > 0 then exit;
if RadioGroup1.ItemIndex = 0 then
begin
DrawGrid1.Canvas.Brush.Color := clRed;
Gred[acol, arow] := 1;
end
else
begin
if Assigned(FSrc) and Assigned(FDes) then exit;
if not Assigned(FSrc) then
begin
Gred[acol,arow] := 2;
New(FSrc);
FSrc.Col := ACol;
FSrc.Row := ARow;
FSrc.vG := 0;
// SetCountH(FSrc);
FSrc.vH := 100;
FSrc.Parent := nil;
end
else //if not Assigned(FDes) then
begin
Gred[ACol, ARow] := 3;
New(FDes);
FDes.Col := ACol;
FDes.Row := ARow;
FDes.vH := 0;
//SetCountG(FDes);
end;
// else exit;
DrawGrid1.Canvas.Brush.Color := clGreen;
end;
DrawGrid1.Canvas.Ellipse(DrawGrid1.CellRect(acol, arow));
// Caption := 'col: ' + IntToStr(ACol) + ' row: ' + IntToStr(ARow);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
i,j: integer;
begin
DrawGrid1.Repaint;
for i := 0 to 9 do
for j := 0 to 9 do
Gred[i, j] := 0;
{Dispose(FDes);
Dispose(FSrc);}
if Assigned(FDes) then
begin
if OpenList.IndexOf(FDes) > -1 then
OpenList.Remove(FDes);
if CloseList.IndexOf(FDes) > -1 then
CloseList.Remove(FDes);
end;
if Assigned(FSrc) then
begin
if OpenList.IndexOf(FSrc) > -1 then
OpenList.Remove(FSrc);
if CloseList.IndexOf(FSrc) > -1 then
CloseList.Remove(FSrc);
end;
ClearList(OpenList);
ClearList(CloseList);
{ }
// SetLength(pt, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
BitBtn1Click(nil);
OpenList := TList.Create;
CloseList := TList.Create;
end;
function TForm1.Go(cDes,rDes,cSrc,rSrc: integer): Boolean;
begin
Result := False;
Result := True;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClearList(OpenList);
OpenList.Free;
ClearList(CloseList);
CloseList.Free;
end;
procedure TForm1.AddOpenList(pt: PGridNode);
begin
OpenList.Add(pt);
end;
procedure TForm1.AddCloseList(pt: PGridNode);
begin
try
CloseList.Add(pt);
OpenList.Remove(pt);
except
RaiseLastWin32Error;
end;
end;
procedure TForm1.AddRoundToOpenList(pt: PGridNode);
procedure AddIn(vCol, vRow: Integer);
var
NewPt: PGridNode;
begin
if IsExist(CloseList, vCol, vRow) or (Gred[vCol, vRow] = 1) then {如果该节点是障碍物或者该节点已经存在于关闭列表中则跳过}
Exit;
if IsExist(OpenList, vCol, vRow, NewPt) then {如果该节点已经存在于开启列表}
begin
if NewPt.vG + NewPt.vH < pt.vG + pt.vH then {比较G值，较小的话作为父节点，并重新计算G，H}
begin
NewPt.Parent := pt;
SetCountG(NewPt);
SetCountH(NewPt);
end;
end
else begin {否则创建该新节点，添加到开启列表。}
New(NewPt);
Newpt.Col := vCol;
Newpt.Row := vRow;
NewPt.Parent := pt;
SetCountG(NewPt);
SetCountH(NewPt);
if NewPt.vH = 0 then
begin
Dispose(NewPt);
NewPt := ptDes;
NewPt.Parent := pt;
Found := True;
end;
OpenList.Add(NewPt);
end;
end;
begin
if (pt.Col - 1 >= 0) then {左节点}
AddIn(pt.Col - 1, pt.Row);
if (pt.Col + 1 < MaxCol) then {右节点}
AddIn(pt.Col + 1, pt.Row);
if (pt.Row - 1 >= 0) then {上节点}
AddIn(pt.Col, pt.Row - 1);
if (pt.Row + 1 < MaxRow) then {下节点}
AddIn(pt.Col, pt.Row + 1);
end;
function TForm1.GetMaxCol: integer;
begin
Result := DrawGrid1.ColCount;
end;
function TForm1.GetMaxRow: integer;
begin
Result := DrawGrid1.RowCount;
end;
{}
procedure TForm1.SetCountG(var Node: PGridNode);
begin
if Node.Parent <> nil then
Node.vG := Node.Parent.vG + 1
else Node.vG := 0;
end;
function TForm1.GetptDes: PGridNode;
begin
Result := FDes;
end;
function TForm1.GetptSrc: PGridNode;
begin
Result := FSrc;
end;
procedure TForm1.SetptDes(const Value: PGridNode);
begin
FDes := Value;
end;
procedure TForm1.SetptSrc(const Value: PGridNode);
begin
FSrc := Value;
end;
procedure TForm1.SetCountH(var Node: PGridNode);
begin
Node.vH := Abs(Node.Col - ptDes.Col) + abs(Node.Row - ptDes.Row);
end;
function TForm1.FindWithA: Boolean;
var
CurNode: PGridNode;
// iCount : Integer;
begin
Result := False;
AddOpenList(ptSrc);
CurNode := ptSrc;
while (not Found) and (OpenList.Count <> 0) do
begin
CurNode := GetMinF;
AddCloseList(CurNode);
AddRoundToOpenList(CurNode);
end;
if OpenList.Count = 0 then
Exit
else begin
CurNode := ptDes;
Memo1.Lines.Add('-------搜索路径如下：-------');
Memo1.Lines.Add('Row: ' + IntToStr(CurNode^.Row)
+ ' Col: ' + IntToStr(CurNode^.Col));
DrawGrid1.Canvas.Pen.Color := cl3DDkShadow;
DrawGrid1.Canvas.Pen.Width := 3;
DrawGrid1.Canvas.MoveTo(CurNode^.Col * 24 + 15, CurNode^.Row * 24 + 15 );
while (CurNode.Parent <> ptSrc) do
begin
CurNode := CurNode.Parent;
DrawGrid1.Canvas.LineTo(CurNode^.Col * 24 + 15, CurNode^.Row * 24 + 15 );
Memo1.Lines.Add('Row: ' + IntToStr(CurNode^.Row)
+ ' Col: ' + IntToStr(CurNode^.Col));
end;
DrawGrid1.Canvas.LineTo(ptSrc^.Col * 24 + 15, ptSrc^.Row * 24 + 15 );
Found := False;
end; {}
Result := True;
end;
function TForm1.IsExist(FList: TList; vNode: PGridNode): Boolean;
var
i:Integer;
begin
Result := False;
for i := 0 to FList.Count - 1 do
if (PGridNode(FList.Items[i]).Col = vNode.Col)
and (PGridNode(FList.Items[i]).Row = vNode.Row) then
Result := True;
end;
function TForm1.IsExist(FList: TList; Col, Row: Integer): Boolean;
var
i:Integer;
begin
Result := False;
for i := 0 to FList.Count - 1 do
if (PGridNode(FList.Items[i])^.Col = Col)
and (PGridNode(FList.Items[i])^.Row = Row) then
Result := True;
end;
function TForm1.GetMinF: PGridNode;
var
i: Integer;
begin
try
Result := OpenList.Items[0];
for i := 1 to OpenList.Count - 1 do
if (Result.vG + Result.vH) > (PGridNode(OpenList.Items[i]).vG + PGridNode(OpenList.Items[i]).vH) then
Result := OpenList.Items[i];
except
raise Exception.Create('No OpenList');
end;
end;
function TForm1.NextIsTrue(pt: PGridNode): Boolean;
begin
Result := False;
if pt.vH = 1 then
Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not FindWithA then
MessageDlg('无法到达目标', mtInformation, [mbOK], 0);
end;
function TForm1.IsExist(FList: TList; Col, Row: Integer;
var pt: PGridNode): Boolean;
var
i:Integer;
begin
Result := False;
for i := 0 to FList.Count - 1 do
if (PGridNode(FList.Items[i])^.Col = Col)
and (PGridNode(FList.Items[i])^.Row = Row) then
begin
pt := PGridNode(FList.Items[i]);
Result := True;
end;
end;
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if Gred[ACol, ARow] = 1 then
Begin
DrawGrid1.Canvas.Brush.Color := clRed;
DrawGrid1.Canvas.Ellipse(DrawGrid1.CellRect(ACol, ARow));
end
else if (Gred[ACol, ARow] = 2) or (Gred[ACol, ARow] = 3) then
begin
DrawGrid1.Canvas.Brush.Color := clGreen;
DrawGrid1.Canvas.Ellipse(DrawGrid1.CellRect(ACol, ARow));
end;
//DrawGrid1.Canvas.TextOut(Acol*24 +2, ARow*24+2, IntToStr(ACol) +', ' + IntToStr(ARow));
end;
procedure TForm1.ClearList(var List: TList);
var
i: Integer;
Pt: PGridNode;
begin
if Assigned(List) then
for i := list.Count - 1 downto 0 do
begin
Pt := PGridNode(List.Items[i]);
List.Delete(i);
Dispose(Pt);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
iCount: Integer;
begin
Memo1.Lines.Clear;
for iCount := 0 to OpenList.Count - 1 do
Memo1.Lines.Add('Row: ' + IntToStr(PGridNode(OpenList.Items[iCount])^.Row)
+ ' Col: ' + IntToStr(PGridNode(OpenList.Items[iCount])^.Col));
end;
end.
