Var p: pElem; {поточний покажчик }

begin

new(p);

P^.pver:=v; {виділити пам'ять для елемента черги }

p^.PFrom:=q; {покажчик на попередню суміжну вершину }

p^.Prev:=PEnd^.Prev; {Зв'язати поточний елемент }

p^.Next:=PEnd; {із кінцевим у черзі }

pend^.Prev^.Next:=p;

pend^.Prev:=p;

end;

{============ видалення елемента з черги ==============}

procedure DelList(e:pElem);

{параметр - покажчик на елемент, що видаляється}

var p: PElem;

begin

if e = nil then exit; {якщо елемент порожній.

вийти з програми }

e^.Next^.Prev:=e^.Prev; {переадресувати покажчики }

e^.Prev^.Next:=e^.Next;

dispose(e); {звільнити пам'ять з-під елемента}

end;

{========== виведення поточного елемента черги =========}

procedure Output(e:pelem);

begin

if e = nil then exit; {якщо елемент порожній,

вийти з програми }

output(e^.PFrom); {вивести решту черги }

if e^.PVer^.number <> finish then {елемент не }

write(e^.PVer^.number, ' -> ') {останній }

else write(e^.PVer^.number, ' '); {елемент останній}

end;

{================= видалення черги ==================}

procedure Clear;

var PCurrent, PDel:PElem;

begin

PCurrent:=PBeg^.Next;

while PCurrent <> PEnd do {поки не досягнуто }

begin {кінця черги }

PDel:=PCurrent; {покажчик на елемент, що видаляється}

PCurrent:=PCurrent^.Next; {переадресувати покажчик

на наступний елемент }

DelList(PDel); {видалити елемент }

end;

end;

{======================= пошук ушир =============—=======}

procedure BreadthFirstSearch;

var i:integer; {параметр циклу}

begin

clrscr;

writeln(' breadth first search ');

writeln ('******************');

write('initial vertex : ');readln(start);

write('terminal vertex : '); readln(finish);

AddList(a[start], nil); {додати в чергу вершину }

for i:=1 to n do {задати ознаки відвідування}

a[i]^.mark:=false; {вершин графу }

PCur:=PBeg^.Next; {вибрати початок черги }

while PCur <> PEnd do {поки не досягнуто кінця черги}

begin

PCur^.PVer^.mark:=true; {відмітити вершину графу }

if PCur ^.PVer^.number = finish then

begin {якщо вершина остання в черзі, то}

write(' Path : ');

output(pCur); {вивести чергу}

clear; {очистити чергу}

readln;

exit; {вийти з циклу}

end;

{якщо вершина графу не остання}

for i :=1 to PCur^.PVer^.k do

begin {якщо вершина не відмічена}

if not PCur^.PVer^.vertex[i]^.mark then

{додати вершину до черги }

AddList(PCur^.PVer^.vertex[i], PCur);

end;

PCur:=PCur^.Next; {перейти до наступної вершини}

end;

writeln('Path not found ');

readln;

clear; {очистити чергу}

end;

{============ основний блок програми ==================}

begin

assign(f,'graph.lin');

new(PBeg); new(PEnd);

PBeg^.Prev:=nil; pbeg^.Next:=PEnd;

Pend^.Prev:=PBeg; Pend^.Next:=nil;

init;

repeat

clrscr;

writeln('Number of vertexes = ', n);

writeln('**********************************');

writeln('press <Enter> to solution');

writeln('<Esc> - to exit');

key:=readkey;

case key of

#13 : BreadthFirstSearch; {нaтиснуто клавішу Enter}

#27 : halt; {натиснуто клавішу Esc }

end;

until false;

end.

Використаємо алгоритм пошуку вглибину для знаходження шляхів від стартової вершини до кінцевої в неорієнтованому графі. Структура графу записана в тек­стовому файлі, перший рядок якого містить кількість вершин графу, а кожний на­ступний рядок — два числа, що є номерами певних суміжних вершин. Тобто ко­жен рядок файла, починаючи з другого, визначає ребро графу. Номери стартової та кінцевої вершин користувач вводить з клавіатури.

Для зображення графу використаємо список суміжності. Тип вершини назве­мо TVer. Запис типу TVer міститиме такі поля: поточний номер вершини, кількість суміжних із нею вершин, масив покажчиків на суміжні вершини, ознаку відвіду­вання вершин. Сам граф задамо масивом а, елементи якого будуть покажчиками на записи TVer.

Ініціалізація масиву вершин даними, що зчитані з вхідного файла, виконуєть­ся у процедурі Init, з якої викликається процедура зв'язування суміжних вершин LinkVertex. Зазначимо, що, оскільки розглядається неорієнтований граф, одному ребру відповідають два зв'язки між вершинами.

Власне пошук вглибину здійснює рекурсивна процедура Search, що є локаль­ною процедурою щодо процедури DepthFirstSearch (пошук вглибину). У проце­дурі DepthFi rstSearch запрограмовані введення початкової і кінцевої вершин для пошуку, помітка початкової вершини як такої, що вже опрацьована, і всіх інших вершин як таких, що потребують перегляду, а також виклик процедури Search.

program vglyb; {пошук вглибину }

uses crt;

type

PtrVer = ^TVer; {тип покажчика на вершину графу }

TVer = record {тип вершини графу }

vertex:array[1..50] of PtrVer; {масив суміжних вершин}

k, {кількість суміжних вершин }

number:integer; {номер вершини }

mark: boolean; {ознака відвідування вершини }

end;

var a:array[1..50] of PtrVer; {масив покажчиків

на вершини графу}

n: integer; {кількість вершин графу }

f:text; {текстовий файл зі списком суміжності }

key:char; {символ обраної' користувачем дії }

start, {номер початкової вершини обходу графу}

finish:integer; {номер кінцевої вершини }

{======== встановлення зв'язків між вершинами графу ========}

procedure LinkVertex(var v,u:PtrVer);

{v.u - покажчики на вершини, що зв'язуються}

begin

{включити u в список суміжності v}

inc(v^.k); v^.vertex[v^.k]:=u;

{включити v у список суміжності u}

inc(u^.k); u^.vertex[u^.k]:=v;

end;

{===========ініціалізація графу з файла ==================}

procedure Init;

var i, {параметр циклу }

iv,iu:integer; {номери суміжних вершин }

Ver:PtrVer; {покажчик на вершину графу }

begin

assign(f,'t.dat') ;

reset(f); {відкрити файл списку суміжних вершин}

readln(f,n); {зчитати кількість вершин графу }

for i:=1 to n do {створити масив покажчиків на }

begin {вершини графу }

new(Ver); {виділити пам'ять для покажчика }

Ver^.number:=i; {визначити номер вершини }

Ver^.k:=0; {задати кількість суміжних вершин }

a[i]:=Ver; {записати покажчик на вершину в масив }

end;

while not eof(f) do {поки не досягнуто кінця файла }

begin

readln(f, iv, iu); {читати номери суміжних вершин }

LinkVertex(a[iv], a[iu]); {зв'язати вершини }

end;

close(f); {закрити файл }

end;

{================== пошук вглибину ====================}

procedure DepthFirstSearch;

var

w:array [1..50] of integer; {масив номерів вершин маршруту}

i,j:integer; {лічильники циклів }

{============= алгоритм пошуку вглибину =================}

procedure Search(V:PtrVer);

{V - покажчик на початкову вершину }

var i:integer;

begin

if V^.number = finish then {якщо досягнуто кінцевої }

begin {вершини, }

write( 'Path: >> '); {вивести маршрут }

for i:=1 to j do

write(w[i], ' -> ');

writeln;

Exit;

end

else {якщо кінцевої вершини не досягнуто,}

for i:=1 to v^.k do {перегляд усіх суміжних вершин}

begin

{якщо поточна вершина не помічена,}

if not V^.vertex[i]^.mark then

begin

v^.vertex[i]^.mark:=true; {помітити вершину }

j:=j+1; {збільшити лічильник помічених вершин}

w[j]:=v^.vertex[i]^.number; {запам'ятати номер

вершини}

Search(v^.vertex[i]); {перейти до наступних}

j:=j-1; {вершин }

v^.vertex[i]^.mark:=false; {зняти помітку з }

{пройденої вершини }

end;

end;

end;

{основний блок процедури пошуку вглибину}

begin

clrscr;

writeln('<< depth first search >>');

write('initial vertex : ');

readln(start);

write('terminal vertex : ');

readln(finish);

for i:=1 to n do {усі вершини вважати непоміченими}

a[i]^.mark:=false;

a[start]^.mark:=true; {помітити початкову вершину }

j:=1; {задати номер початкової вершини у маршруті}

w[j]:=start;

Search(a[start]); {виклик рекурсивної процедури пошуку}

readln;

end;

{============== основний блок програми ======================}

begin

assign(f, 'graph.lin');