Поиск в ширину в графе Опции

[Aleks]

Помогите решить задачу
Напишите и используйте в программе процедуру поиска в ширину в графе, заданном списками инцидентности. Выведите на экран номера всех вершин в порядке очередности просмотра.

я не знаю с чего начать, посмотрел в "FAQ" но не смог разобраться

[Aleks]

как освободить память, не могу сообразить

Исходный код

uses crt;
const
max=400;
type
index= ^list;
list= record
inf: integer;
next: index;
end;
connection= array[1..max] of index;

var
lst, m: connection;
ver: array[1..max] of integer;
ocher: array[1..max+1] of integer;
key, z, raz: integer;
find_v: boolean;

procedure DP_Graph;
var
n: index;
i, j: integer;
kolvo: longint;
spro: boolean;

procedure add;
begin
new(m[i]);
m[i]^.inf:= ver[j];
m[i]^.next:= lst[i];
lst[i]:= m[i];
inc(kolvo);
end;

begin
randomize;
for i:=1 to raz do ver[i]:= random(1000);
kolvo:= 0;
for i:=1 to raz do
begin
lst[i]:= nil;
for j:=1 to raz do
begin
spro:= true;
if j<> raz then
begin
if j=i then inc(j);
n:= nil;
n:= lst[j];
if lst[j]<>nil then
repeat
if n^.inf=ver[i] then spro:= false;
n:= n^.next;
until (n=nil) or (not(spro));
if (round(random)=1) and spro then add;
end;
end;
end;
writeln('Kol-vo reber Grapha: ',kolvo);
writeln;
end;

procedure print_ver;
var
i: integer;
begin
for i:=1 to raz do
begin
write(ver[i],'');
m[i]:= lst[i];
if m[i]<>nil then
repeat
write(m[i]^.inf,'=');
m[i]:= m[i]^.next;
until m[i]= nil;
writeln('');
end;
end;

procedure find_Graph(find_v: boolean; key: integer);
var
q: integer;
t, ov, oc, i: integer;
pr: boolean;

procedure p_ver;
var
j, i: integer;
pr: boolean;
begin
for i:=2 to raz do
begin
m[i]:= lst[i];
repeat
pr:= false;
q:= m[i]^.inf;
m[i]:= m[i]^.next;
if ocher[oc]=q then
begin
for j:=1 to ov do if ocher[j]=ver[i] then pr:= true;
if pr=false then
begin
ocher[ov]:= ver[i];
inc(ov);
end;
end;
until m[i]=nil;
end;
i:= 2;
end;

begin
ov:= 1; oc:= 1;
ocher[oc]:= ver[oc];
m[oc]:= lst[oc];
while m[oc]<>nil do
begin
q:= m[oc]^.inf;
m[oc]:= m[oc]^.next;
inc(ov);
ocher[ov]:= q;
end;
inc(ov);
p_ver;
if ocher[oc]=key then find_v:= true;
while oc<raz do
begin
inc(oc);
for i:=1 to raz do
begin
p_ver;
if ocher[oc]=ver[i] then
begin
m[i]:= lst[i];
while m[i]<> nil do
begin
pr:= false;
q:= m[i]^.inf;
m[i]:= m[i]^.next;
for t:=1 to ov do if ocher[t]=q then pr:= true;
if pr=false then
begin
ocher[ov]:= q;
inc(ov);
end;
end;
end;
end;
if ocher[oc]=key then find_v:= true;
end;
if not(find_v) then writeln('К сожалению такой вершины нет...')
else writeln('Вершина графа ',key,' найдена!');
end;

procedure delet;
begin

end;

begin
repeat
clrscr;
writeln('--', memavail);
write('Kol-vo vershin Grapha (ne menee 4) : ');
readln(raz);
until raz>3;
DP_Graph;
print_ver;
write('Vvedite iskom vershinu: ');
readln(key);
find_v:= false;
find_Graph(find_v,key);
for z:=1 to raz do write(ocher[z],' - ');
writeln;
delet;
writeln;
writeln('--', memavail);
readln;
end.