Пошук у глибину

Другим способом пошуку шляху в графі є пошук у глибину.

Для реалізації цього способу доцільно використати стек.
Розглянемо приклад такого пошуку для графу, зображеного на мал. 21.

Почнемо пошук шуканої вершини 7 із заданої вершини 1.

Дія	Вміст стеку	Вже відвідувані вершини
Запишемо до стеку номер вершини 1	1
Читаємо зі стеку номер вершини 1. Помічаємо вершину 1 як відвідувану		1
Перевіряємо у матриці суміжності суміжні з вершиною 1 вершини. Це вершини 2, 3, 4. Шуканої серед них немає. Ці вершини ще не відвідувані		1
Запишемо до стеку номери вершин 2, 3, 4	2, 3, 4	1
Читаємо зі стеку номер вершини 4. Помічаємо вершину 4 як відвідувану	2, 3	1, 4
Перевіряємо у матриці суміжності суміжні з вершиною 4 вершини. Це вершини 1, 3. Шуканої серед них немає. Вершина 3 ще не відвідувана	2, 3	1, 4
Запишемо до стеку номер вершини 3	2, 3, 3	1 ,4
Читаємо зі стеку номер вершини 3. Помічаємо вершину 3 як відвідувану	2, 3	1, 4
Перевіряємо у матриці суміжності суміжні з вершиною 3 вершини. Це вершини 1, 2, 4, 5. Шуканої серед них немає. Вершини 2 та 5 ще не відвідувані	2, 3	1, 4
Запишемо до стеку номери вершин 2 та 5	2, 3, 2, 5	1, 4
Читаємо зі стеку номер вершини 5. Помічаємо вершину 5 як відвідувану	2, 3, 2	1, 4, 5
Перевіряємо у матриці суміжності суміжні з вершиною 5 вершини. Це вершини 2, 3, 7. Вершина 7 шукана	2, 3, 2	1, 4, 5
Виходимо з циклу. Виводимо повідомлення про те, що шлях знайдено

Перейдемо до реалізації описаного алгоритму у вигляді програми:

Var

    stack:array[0..100] of integer;

    top:integer;

procedure Push(x:integer);

begin

    top:=top+1;

    stack[top]:=x;

end;

function Pop(var x:integer):boolean;

begin

    if top<1 then

        Pop:=false //Черга порожня

    else begin

      Pop:=true;  //Черга не порожня

      x:=stack[top];

      top:=top-1;

    end;

end;

procedure TForm1.Button1Click(Sender: TObject);

const Nmax = 100;

var  v,r,a,b,x,i,j,p,k,n : Integer;

     matr:array[1..Nmax,1..Nmax] of Integer;

     s:string;

     vp:set of 1..Nmax;

     NoFound:boolean;

begin  

        n:=0;

        //Заповнюємо матрицю суміжності нулями

        For i := 1 To Nmax do

            For j := 1 To Nmax do

                matr[i,j]:=0;

        //Читаємо дані з Memo1 та заповнюємо матрицю суміжності

        For i := 0 To Memo1.Lines.Count - 1 do begin

            s := Memo1.Lines[i];

            s := Trim(s);

            while pos('  ',s)<>0 do delete(s,pos('  ',s),1);

            If (s <> '') and (pos(' ',s)<>0) Then begin

                x := pos(' ',s);

                a := StrToInt(copy(s,1,x-1));

                b := StrToInt(copy(s,x+1,Length(s)-x));

                matr[a, b] := 1;

                matr[b, a] := 1;

                If a > n Then n := a;

                If b > n Then n := b;

            end

        end;

        //Рахуємо кількість ребер

        r := 0;

        For i := 1 To n do begin

            For j := 1 To n do begin

                If matr[i, j] = 1 Then r := r + 1;

            end;

        end;

        r := r div 2;

        p:=StrToInt(Edit1.Text);

        k:=StrToInt(Edit2.Text);

        //'=================================================================='

        //                      Початок пошуку

        //'=================================================================='

        NoFound:=true;

        vp:=[];

        top:=0;

        //Поміщаємо початкову вершину в стек

        Push(p);

        //Запускаємо цикл поки стек не порожній та не знайдено кінцеву вершину

        While Pop(v) And NoFound do begin

            //Командою  Pop(v) ми прочитали зі стеку до змінної v номер вершини

            //Після чого відмічаємо цю вершину як пройдену

            vp:=vp+[v];

            //Переглядаємо у матриці суміжності всі вершини, суміжні з нею

            For i := 1 To n do begin

                If matr[v, i] <> 0 Then begin

                    //Якщо знайдено суміжну вершину, то перевіряємо, чи не є вона шуканою

                    //і якщо це так, то змінній NoFound присвоюємо значення False

                    If i = k Then NoFound := False ;

                    //Якщо ця вершина не відвідувана, то ставимо її в чергу

                    If not (i in vp) Then Push(i);

                End;

            End;

        End;

        //Виводимо результат пошуку

        If NoFound Then

            Label4.Caption := 'Результат: шлях не знайдено'

        Else

            Label4.Caption := 'Результат: шлях знайдено'

end;