Помогите пожалуйста с программкой:
"Поиск кратчайшего пути в графе методом полного перебора в ширину с использованием АТД очередь"
Сам алгоритм у меня есть, но ничего не знаю про АТД очередь, ни у кого нет примеров такой программы?
procedure Quepush(start);
While not QueueEmpty do
begin
Current:=Quepop
Finished:=Current=finish;
j:=1;
while j<=N do
begin
if (M[Current,j]<>0) and not visited(j,way) then
begin
Way[j]:=Current;
Finished:=j=finish;
if not Finished then QueuePush(j)
else
begin
i:=finish;
while i<>start do
begin
write(Way[i]:3);
i:=Way[i];
end;
writeln;
end;
inc(j);
end;
end;
end;
uses queue_oop;(я использовал собственный модуль queue_oop, в принципе можешь использовать любой другой, по названиям методов понятно, что они делают: Put - забрасывает элемент в конец очереди, Get - вытаскивает элемент из ее начала)
const
N = 6;
M: array[1 .. N, 1 .. N] of integer = (
(0, 2, 0, 8, 0, 0),
(0, 0, 3, 0, 7, 0),
(0, 0, 0, 0, 1, 0),
(0, 0, 0, 0, 6, 0),
(0, 0, 0, 0, 0, 4),
(0, 0, 0, 0, 0, 0)
);
type
WayType = array[1 .. N] of integer;
function visited(what: integer; path: WayType): boolean;
var i: integer;
begin
visited := true;
for i := low(path) to high(path) do
if path[i] = what then exit;
visited := false;
end;
var
q: TQueue;
i, j, start, finish, current: integer;
finished: boolean;
Way: WayType;
begin
q.init;
start := 1; finish := 5;
q.put(start);
While not q.isEmpty do begin
Current := q.get;
Finished := Current = finish;
j:=1;
while j<=N do begin
if (M[Current,j] <> 0) and not visited(j, way) then begin
Way[j] := Current;
Finished:=(j = finish);
// если не закончили перебор - добавляем очередную вершину
// в очередь, чтобы потом к ней вернуться...
if not Finished then q.put(j)
end;
inc(j);
end;
end;
// а когда закончили - то печатаем путь
// от конечной вершины к начальной
i:=finish;
write(i:3);
while i<>start do begin
write(Way[i]:3);
i:=Way[i];
end;
writeln;
end.
Function QueuePop(var q:TQueue):TElem;
var
z:TList;
begin
z:=q.head;
q.head:=z^.next;
QueuePop:=Z^.info;
dispose(z)
end;
unit road2_;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, Queue;
const
N=6;{ кол-во вершин графа}
type
WayType = array[1 .. N] of integer;
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
Label4: TLabel;
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormActivate(Sender: TObject);
var
i:integer;
begin
// нумерация строк
for i:=1 to 10 do
StringGrid1.Cells[0,i]:=IntToStr(i);
// нумерация колонок
for i:=1 to 10 do
StringGrid1.Cells[i,0]:=IntToStr(i);
// описание предопределенной карты
StringGrid1.Cells[1,2]:='1';
StringGrid1.Cells[2,1]:='1';
StringGrid1.Cells[1,3]:='1';
StringGrid1.Cells[3,1]:='1';
StringGrid1.Cells[1,4]:='1';
StringGrid1.Cells[4,1]:='1';
StringGrid1.Cells[3,7]:='1';
StringGrid1.Cells[7,3]:='1';
StringGrid1.Cells[4,6]:='1';
StringGrid1.Cells[6,4]:='1';
StringGrid1.Cells[5,6]:='1';
StringGrid1.Cells[6,5]:='1';
StringGrid1.Cells[5,7]:='1';
StringGrid1.Cells[7,5]:='1';
StringGrid1.Cells[6,7]:='1';
StringGrid1.Cells[7,6]:='1';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
M:array[1..N,1..N] of integer;
q: TQueue;
i, j, start, finish, current: integer;
finished: boolean;
Way: WayType;
function visited(what: integer; path: WayType): boolean;
var i: integer;
begin
visited := true;
for i := low(path) to high(path) do
if path[i] = what then exit;
visited := false;
end;
procedure step;
begin
queueinit(q);
queuepush(q,start);
While not queueEmpty(q) do begin
Current := queuepop(q);
Finished := Current = finish;
j:=1;
while j<=N do begin
if (M[Current,j] <> 0) and not visited(j, way) then begin
Way[j] := Current;
Finished:=(j = finish);
if not Finished then queuepop(q)
end;
inc(j);
end;
end;
i:=finish;
while i<>start do begin
i:=Way[i];
end;
Label1.Caption:=label1.Caption+' '+IntToStr(way[i]);
end;
begin
Label1.caption:='';
for i:=1 to N do
for j:=1 to N do
if StringGrid1.Cells[i,j] <> ''
then M[i,j]:=StrToInt(StringGrid1.Cells[i,j])
else M[i,j]:=0;
start:=StrToInt(Edit1.text);
finish:=StrToInt(Edit2.text);
step;
end;
end.
procedure step;
begin
queueinit(q);
queuepush(q, start);
While not queueEmpty(q) do begin
Current := queuepop(q);
Finished := Current = finish;
j := 1;
while j<=N do begin
if (M[Current,j] <> 0) and not visited(j, way) then begin
Way[j] := Current;
Finished:=(j = finish);
if not Finished then queuepush(q, j) // <--- Здесь и в оригинале было q.put(j), а не q.get
end;
inc(j);
end;
end;
// Label1 заполняется вот так:
Label1.Caption := IntToStr(finish);
i := finish;
while i <> start do begin
i := Way[i];
Label1.Caption := Label1.Caption + ' ' + IntToStr(i);
end;
end;
procedure step;
begin
queueinit(q);
queuepush(q,start);
While not queueEmpty(q) do begin
Current := queuepop(q);
Finished := Current = finish;
j:=1;
while j<=N do begin
if (M[Current,j] <> 0) and not visited(j, way) then begin
Way[j] := Current;
Finished:=(j = finish);
if not Finished then queuepop(q)
end;
inc(j);
end;
end;
end;
begin
Label1.caption:='';
for i:=1 to N do
for j:=1 to N do
if StringGrid1.Cells[i,j] <> ''
then M[i,j]:=StrToInt(StringGrid1.Cells[i,j])
else M[i,j]:=0;
start:=StrToInt(Edit1.text);
finish:=StrToInt(Edit2.text);
step;
while i<>start do begin
Label1.caption:=IntToStr(way[i]);
end;
end;
end.
// Label1 заполняется вот так:
Label1.Caption := IntToStr(finish);
i := finish;
while i <> start do begin
i := Way[i];
Label1.Caption := Label1.Caption + ' ' + IntToStr(i);
end;