全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:5295
推到 Plurk!
推到 Facebook!

路徑搜尋

答題得分者是:syntax
inglong
初階會員


發表:28
回覆:27
積分:36
註冊:2004-08-13

發送簡訊給我
#1 引用回覆 回覆 發表時間:2007-04-09 18:49:47 IP:220.134.xxx.xxx 訂閱
 大家好,小弟在寫A*路徑搜尋,給一個起點和終點,地圖上有障礙,找出兩點間的路徑
小弟的想法:將起點存入list:假定為open,然後找尋相鄰的八個點,如果是可以通過的也加入open這個list
並計算相鄰八個點的cost, 找出可以通行且cost最少的點 假設為B,將A從open刪除存入close裡面,將B存入open並尋找相鄰的八個點反覆操作
直到找到終點

大概寫了下面這些 不過會有問題 請各位幫我看看
button1和button2:是產生地圖,SG是一個TStringGrid
button4是要做路徑搜尋的,就是按下button4的時候會出現錯誤
不過執行會出錯,小弟功力不足只好求助各位幫忙看看
<textarea class="delphi" rows="10" cols="60" name="code">unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ExtCtrls ,Math; type TForm1 = class(TForm) SG: TStringGrid; Button1: TButton; Button2: TButton; Button4: TButton; procedure creatmap; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; map:array of array of string; n:integer=5; sx,sy,ex,ey:integer; implementation {$R *.DFM} procedure Tform1.creatmap; var i,j,k,m,l:integer; begin n:=strtoint(inputbox('產生地圖','請輸入大小n*n','5')); setlength(map,n,n); SG.ColCount:=n 1; SG.RowCount:=n 1; for i:=0 to n-1 do begin for j:=0 to n-1 do begin map[i,j]:='0'; end; end; randomize; k:=0; while k < (n*n div 4) do begin i:=random(n-1); j:=random(n-1); if map[i,j]='0' then map[i,j]:='1'; k:=k 1; end; k:=0; while k<2 do begin i:=random(n-1); j:=random(n-1); if map[i,j]='0'then begin k:=k 1; if k=1 then map[i,j]:='A'; if k=2 then map[i,j]:='B'; end; end; for m:=0 to n-1 do begin for l:=0 to n-1 do begin SG.Cells[m 1,l 1]:=map[m,l]; end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin creatmap; end; procedure TForm1.Button2Click(Sender: TObject); var i,j:integer; tmp:integer; begin for i:=0 to n-1 do begin for j:=0 to n-1 do begin if map[i,j]='0' then begin SG.Font.Color:=clred; SG.Cells[i 1,j 1]:='V'; end else if map[i,j]='A' then begin sx:=i; sy:=j; SG.Font.Color:=clred; SG.Cells[i 1,j 1]:='A'; end else if map[i,j]='B' then begin ex:=i; ey:=j; SG.Font.Color:=clred; SG.Cells[i 1,j 1]:='B'; end else begin SG.Cells[i 1,j 1]:=''; end; end; end; end; const delta: array[0..7] of TPoint = ((x:-1; y:0), (x:-1; y:1), (x:0; y:1), (x:1; y:1), (x:1; y:0), (x:1; y:-1), (x:0; y:-1), (x:-1; y:-1)); type pstack=^Tstack; Tstack=record point:Tpoint; cost:integer; data:integer; next:pstack; end; var open,close,beback:TList; function getcost(x,y,sx,sy,gx,gy:integer):integer; var h,g,f:integer; begin if (x=sx) and (y=sy) then result:=0; h:=abs(sx-x)*10 abs(sy-y)*10; g:=10*(abs(x-gx) abs(y-gy)); f:=g h; result:=f; end; procedure neighbor( A:pstack; G:pstack;n,sx,sy,gx,gy:integer); var i,j:integer; B:array[0..7] of pstack; minstack:pstack; begin new(minstack); for i:=0 to 7 do begin new(B[i]); B[i].point.x:=A.point.x delta[i].x; B[i].point.y:=A.point.y delta[i].y; if (B[i].point.x<0)or(B[i].point.x>n) or(B[i].point.y<0)or(B[i].point.y>n)then begin continue; end else if B[i].data=0 then begin continue; end else begin open.Add(B[i]); B[i].cost:=getcost(B[i].Point.x,B[i].Point.y,sx,sy,gx,gy); minstack:=B[0]; if minstack.cost>B[i].cost then begin minstack:=B[i]; end; end; end; beback.Add(minstack); open.Delete(open.IndexOf(A)); close.Add(A); while (close.IndexOf(G)=-1) or (open.Count<>0) do begin neighbor(open.Last,G,n,sx,sy,gx,gy); end; end; function findpath(var A,B:pstack):boolean; begin result:=false; while (close.IndexOf(B)=-1) or (open.Count<>0) do begin neighbor(A,B,n,A.point.x,A.point.y,B.point.x,B.point.y); end; if close.IndexOf(B)<>-1 then result:=true; end; procedure TForm1.Button4Click(Sender: TObject); var i,j:integer; start,goal:pstack; dot:array of array of pstack; begin open:=Tlist.Create; beback:=Tlist.Create; new(start); new(goal); start.point.x:=sx; start.point.y:=sy; start.data:=1; goal.point.x:=ex; goal.point.y:=ey; goal.data:=1; open.Add(start); setlength(dot,n,n); for i:=0 to n-1 do begin for j:=0 to n-1 do begin new(dot[i,j]); if SG.Cells[i 1,j 1]='V' then begin dot[i,j].data:=1; dot[i,j].point.x:=i; dot[i,j].point.y:=j; end else begin dot[i,j].data:=0; dot[i,j].point.x:=i; dot[i,j].point.y:=j; end; end; end; //會出錯的地方下面這兩行 //neighbor(start,goal,n,start.point.x,start.point.y,goal.point.x,goal.point.y); //findpath(); end; end. </textarea>

------
何需Coding爭峰
千人指 萬人鋒
敢問Coding頂峰
三尺秋水塵不染
天下無雙
syntax
尊榮會員


發表:26
回覆:1139
積分:1258
註冊:2002-04-23

發送簡訊給我
#2 引用回覆 回覆 發表時間:2007-04-14 03:34:17 IP:61.64.xxx.xxx 訂閱
這是資料結構的作業吧

不就是迷宮問題

去看書吧,解答就在裡面

多看書有好處
inglong
初階會員


發表:28
回覆:27
積分:36
註冊:2004-08-13

發送簡訊給我
#3 引用回覆 回覆 發表時間:2007-04-14 14:44:08 IP:220.134.xxx.xxx 訂閱
有看書了 也有做出來 不過是用TObject做
可是宣告太多物件 好像會有記憶體的問題
------
何需Coding爭峰
千人指 萬人鋒
敢問Coding頂峰
三尺秋水塵不染
天下無雙
系統時間:2024-04-20 4:21:25
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!