Алгоритмы поиска в ширину и в глубину в графе

Алгоритмы поиска в ширину и  в глубину в  графе. Построение основного  дерева графа методами поиска в глубину  и ширину. 

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

procedure Input_Table(var A : Matrix; N : longint); //процедура ввода матрицы смежности A(N, N)

var i, j : longint;

begin

    for i := 1 to N do

    begin

        for j := 1 to N do read(A[i, j]);

        readln;

    end;

end;

 

procedure Input_Spisok(var P : Spisok; var V : Ves; M : longint); //процедура ввода списка взвешенных рёбер P(M,2), M - кол-во рёбер.

var i : longint;

begin

    for i := 1 to M do readln(P[i, 1], P[i, 2], V[i]);

end; 

ОСНОВНЫЕ  АЛГОРИТМЫ

Поиск в ширину (BFS).

     Суть  алгоритма заключается в том, чтобы перебрать всех преемников начальной вершины (корневого узла), и дальше по цепочке. Такой алгоритм помогает получить компоненту связности, то есть схему, куда можно прийти из какой-то заданной вершины. Применяя этот алгоритм поочерёдно для всех вершин, можно найти кратчайшее расстояние, оптимальный путь между двумя вершинами и так далее, в зависимости от предложенных условий. 

procedure BFS(A : Matrix; N, V : integer); //обход в ширину (V - корневая вершина)

var i, ps, pe : integer;

visited : array [1..MaxN] of boolean; //массив посещённости вершин

q : array [1..MaxN] of integer; //"очередь" вершин

begin //в качестве списка очередных вершин будем использовать структуру "очередь"

    ps := 1; //начало очереди

    pe := 1; //конец очереди

    q[pe] := v; //в очередь помещается исходная вершина. На каждом шаге в очередь будем заносить всех преемников данной вершины (назовём их 1-го уровня, т.е. до которых можно дойти напрямую). Затем просматриваем в очереди занесённые ранее вершины 1-го уровня и добавляем в конец очереди вершины 2-го уровня и так далее до опустошения очереди.

    visited[v] := TRUE; //вершина V посещена

    while ps <= pe do //пока очередь не пуста

    begin

        for i := 1 to n do if (A[v, i] <> 0) and (not visited[i]) then //перебираем все связные с V вершины

        begin

            inc(pe); //и добавляем в очередь

            q[pe] := i;

            visited[i] := true; //отмечаем вершину I пройденной

        end;

        inc(ps); //переходим к следующей вершине в очереди

        v := q[ps]; //и делаем её корневой

    end;

end; 

Поиск в глубину (DFS)

     Поиск начинается с фиксированной вершины v0. Затем выбирается произвольная вершина u, смежная с v0 и процесс продолжается от u. В общем случае, находясь в вершине v, берем новую (еще не просмотренную) вершину u, u--v; она перестает быть новой и с нее продолжается поиск. Если нет но-вых вершин, смежных с v, то вершина v считается использованной, идет возврат в вершину, из которой попали в v и процесс продолжается до тех пор, пока не станет v = v0. Иными словами, поиск в глубину из вершины v основан на поиске в глубину из всех новых вершин, смежных с v. 

procedure DFS(A : Matrix; N, V : integer); //обход в глубину (V - текущая вершина)

var i : integer;

begin

    visited[v] := TRUE; //вершина V посещена

    for i := 1 to N do if (A[v, i] <> 0) and (not visited[i]) then //если ребро между I и V существует и вершина I не была посещена ранее

    begin

        DFS(A, i); //проверяем вершину I

    end;

end; 

Алгоритм  Дейкстры

     Находит кратчайшее расстояние от одной из вершин графа до всех остальных. Алгоритм работает только для графов без рёбер  отрицательного веса (так как на таком цикле бесконечно будет уменьшатся наилучший путь). На каждом шаге цикла мы ищем вершину с минимальным расстоянием и флагом равным нулю. Затем мы отмечаем её пройденной и проверяем все соседние с ней вершины. Если в ней расстояние больше, чем сумма расстояния до текущей вершины и длины ребра, то уменьшаем его. Цикл завершается когда все вершины будут пройдены. Время работы алгоритма оценивается как O(N^2). 

D : array[1..MaxN] of integer; //массив кратчайших расстояний

procedure Deisktr(A : Matrix; N, s : integer); //s - искомая вершина

var i, j, v, min : longint;

begin

    visited[s] := TRUE; //вершина S посещена

    for i := 1 to N do D[i] := A[s, i]; //изначальный массив расстояний

    for i := 1 to n-1 do //на каждом шаге находим минимальное решение и пытаемся его улучшить

    begin

        min := inf;

        for j := 1 to N do if (not visited[j]) and (D[j] < min) then

        begin

            min := D[j]; //минимальное расстояние

            v := j; //найденная вершина

        end;

        for j := 1 to N do if (D[j] > D[v] + A[v, j]) and (D[v] < inf) and (A[v, j] < inf) then D[j] := D[v] + A[v, j]; //пытаемся улучшить решение. Если в ней расстояние больше, чем сумма расстояния до текущей вершины и длины ребра, то уменьшаем его.

        s := v; //новая текущая вершина

        visited[v] := TRUE; //и она отмечается посещенной

    end;

end; 

Алгоритм  Флойда

     Также находит массив кратчайших расстояний. Но в отличие от алгоритма Дейкстры, он использует динамическое программирование. На каждом шаге цикла k создаётся массив решений, где w[i,j] содержит минимальное расстояние, где используется используются только вершины 1,2..k и сами i и j. На начальном этапе W копирует матрицу смежности. Тогда на каждом k есть два варианта — минимальный путь идёт через вершину k или нет. Теоретически такой метод гораздо легче реализовать (банальный перебор), но использует больше машинных ресурсов, чем Дейкстра (сложность алгоритма оценивается как O(N^3), но зато ищет минимальные пути между всеми парами точек). 

W : array[1..MaxN, 1..MaxN] of longint; //таблица кратчайших путей

function Min(a, b : longint) : longint;

begin

    if a < b then min := a else min := b;

end;

 

procedure floyd(A : Matrix; N : integer);

var i, j, k : integer;

begin

    for i := 1 to N do for j := 1 to N do W[i, j] := A[i, j]; //копируем матрицу смежности в таблицу расстояний

    for k := 1 to N do   //перебираем все наборы вершин (1),(1,2),(1,2,3)...(1,2,3..N)

    for i := 1 to N do

    for j := 1 to N do W[i,j] := min(W[i, j], W[i, k] + W[k, j]); //возможно два варианта: кратчайшее расстояние от i до j проходит через вершину k или нет.

end; 

Алгоритм  Краскала.

     Находит каркас минимального веса, т.е такой  подграф исходного графа, который  бы был связным, содержал все вершины  исходного графа и суммарный вес рёбер был наименьшим. В этой задаче используется список рёбер. Вначале текущее множество рёбер устанавливается пустым. Затем, пока это возможно, проводится следующая операция: из всех рёбер, добавление которых к уже имеющемуся множеству не вызовет появление в нём цикла (т.*е. зачем добавлять ребро R(i,j) в подграф, который содержит эти вершины, а значит, от одной можно добраться до другой), выбирается ребро минимального веса и добавляется к уже имеющемуся множеству. Когда таких рёбер больше нет, алгоритм завершён. Массив рёбер должен быть заранее отсортирован во весу (можно привести док-во: если сначала рассматривать ребро R1(i,j)>R2(i,j), то он потом будет удалён, так как мы встретили в списке рёбер R2(i,j), который весит меньше R1, а удаление рёбер в алгоритме не предусматривается). 

procedure kraskal(V : Spisok; P : Ves; K, N : longint); //поиск подграфа наименьшего веса (метод Краскала). V(K) - данный список рёбер, P - их вес, N - количество вершин

type TSet = set of byte;

var i, j, k1, k2, b, count : integer;

mn : array[1..MaxN]of TSet; //массив множеств

select : array[1..MaxN * MaxN]of boolean; //выбрано ребро или нет

begin

    for i := k downto 1 do //сортировка рёбер по возрастанию веса

    for j:=1 to i-1 do if pp[j] > p[j + 1] then

    begin

        b := P[j];

        P[j] := P[j+1];

        P[j+1] := b;

 

        b := V[j, 1];

        V[j, 1] := V[j+1, 1];

        V[j+1, 1] := b;

 

        b := V[j, 2];

        V[j, 2] := V[j+1, 2];

        V[j+1, 2] := b;

    end; 

    for i := 1 to N do mn[i] := [i]; //создаём N множеств - подграфов. Каждое содержит по одной вершине: [1],[2],[3],[4]...[N]

    count := N; //кол-во подграфов. Если удается найти требуемый подграф, то на выходе должен остаться 1 подграф

    i := 1;

    while (count > 1) and (i <= k) do //пока есть нерассмотенные рёбра и кол-во подграфов больше одного

    begin

        for j := 1 to count do if V[i, 1] in mn[j] then k1 := j else if V[i, 2] in mn[j] then k2 := j; //перебираем все имеющиеся подграфы. В k1 и k2 запоминаем номера подграфов, куда входят вершины, которые соединяют ребро I.

        if k1 <> k2 then //если это два разных подграфа, т.е. текущее ребро соединяет их

        begin

            mn[k1] := mn[k1] + mn[k2]; //то соедияем подграфы!

            mn[k2] := [];

            dec(count); //уменьшаем кол-во подграфов на единицу

            select[i] := TRUE; //текущее ребро отмечаем как использованное

        end;

        inc(i); //переходим к следующему ребру

    end;

    if count = 1 then //если после процедуры остался один подграф - выводим номера всех использованных рёбер, иначе - условий для существования единственного подграфа нет (хотя существуют задачи, где необходимо вычислить такие рёбра или вершины (смотря от контекста задачи), которые будут соединять найденные подграфы)

    begin

        for i := 1 to k do if select[i] then write(i,' ');

        end else write('-1');

    end;

end; 

ПРИМЕРЫ РЕШЕНИЯ ЗАДАЧ  НА ГРАФЫ