Построение минимального остовного дерева (алгоритм Краскала). Алгоритм предназначен для нахождения минимального остовного дерева, т.е. такого подграфа который бы имел столько же компонент связности, сколько и исходный, но не содержал петель и сумма весов всех его ребер была бы минимальной.

Вначале опишем алгоритм (возможно не достаточно строго), а затем обсудим какой способ задания графа был бы наилучшим в данном случае, а так же покажем как от тех способов задания, которые мы использовали ранее перейти к способу применимому здесь.

Итак, алгоритм Краскала:

1. Сортируем ребра графа по возрастанию весов.
2. Полагаем что каждая вершина относится к своей компоненте связности.
3. Проходим ребра в "отсортированном" порядке. Для каждого ребра выполняем:
   
   • если вершины, соединяемые данным ребром лежат в разных компонентах связности, то объединяем эти компоненты в одну, а рассматриваемое ребро добавляем к минимальному остовному дереву;
   • если вершины, соединяемые данным ребром лежат в одной компоненте связности, то исключаем ребро из рассмотрения.
4. Если есть еще нерассмотренные ребра и не все компоненты связности объединены в одну, то переходим к шагу 3, иначе выход. В данном случае работать с матрицей весов не удобно, это выявляется уже на этапе упорядочивания ребер по весу, поэтому создадим временный массив ребер Edges: array of TEdges с соответствующими весами. Каждый элемент этого массива имеет три свойства: начальная вершина, конечная вершина и вес.

TEdges=record // временная структура для ребер 
     n1: word; // № первой вершины 
     n2: word; // № второй вершины 
     A : integer; // вес ребра 
end;

Упорядочиваем ребра по неубыванию весов пузырьковой сортировкой. Далее в алгоритме вводиться массив Link: array of integer элементы, которого характеризуют номер компоненты связности соответствующих вершин (две вершины u1, u2 лежат в одной компоненте связности, если и только если Link[u1] = Link[u2]). Теперь все структуры, используемые в алгоритме, описаны, и его работу легко будет понять из блок-схемы.

В алгоритме используется переменная q, которая инициализируется значением N-1 и затем, при объединении двух компонент связности на шаге 3, q уменьшается на единицу, таким образом, условие q=0 означает, что все вершины лежат в одной компоненте связности и работа алгоритма завершена. Найденное дерево будет определено с помощью стека, в который мы помещаем номера ребер.

Реализация алгоритма Краскала

procedure Craskal; 
// Алгоритм Краскала 
var i,j,q,m,t: integer; 
h: TEdges; 
Link: array of integer;// № связности для вершин 
begin 
     N:=Length(Node); m:=0; 
     for i:=0 to N-1 do // формируем массив всех ребер 
          with Node[i] do begin 
               LL:=Length(Edge); 
                    for j:=0 to LL-1 do begin 
                         Inc(m); SetLength(Edges,m); 
                         Edges[m-1].n1:=i; Edges[m-1].n2:=Edge[j].NumNode; 
                         Edges[m-1].A:=Edge[j].A; 
                    end; 
          end;
          for i:=0 to m-2 do // Сортируем ребра графа по возрастанию весов 
               for j:=m-1 downto i+1 do 
                    if Edges[j].A < h:=Edges[j]; Edges[j]:=Edges[j-1]; Edges[j-1]:=h; 
     end; 

     SetLength(Link,N); // Вначале все ребра в разных компонентах связности 
     for i:=0 to N-1 do Link[i]:=i; 
     i:=0; q:=N-1; 
     while (i<=m-1) and (q<>0) do begin 
          // если вершины в разных компонентах связности 
          if Link[Edges[i].n1]<>Link[Edges[i].n2] then begin 
               t:=Edges[i].n2; Push(Stack,i); // поместить в стек № ребра 
               for j:=0 to N-1 do 
                    if Link[j]=t then 
                         Link[j]:=Link[Edges[i].n1];// в один компонент связности 
               q:=q-1; 
          end; 
          Inc(i); 
     end; 
     SetColorEdge; // закраска ребер 
     SetLength(Edges,0); 
end;

Процедура SetColorEdge извлекает номера ребер из стека и перекрашивает ребра структуры Node[i].

Закраска ребер минимального остова

procedure SetColorEdge; // закраска ребер 
var i,j,t: integer; 
begin 
     while not Stack_IsEmpty(Stack) do begin 
          Stack_Pop(Stack,t); // взять из стека № ребра 
          for i:=0 to N-1 do 
               with Node[i] do begin 
                    LL:=Length(Edge); 
                    for j:=0 to LL-1 do 
                         if ((i=Edges[t].n1) and (Edge[j].NumNode=Edges[t].n2)) or 
                            ((i=Edges[t].n2) and (Edge[j].NumNode=Edges[t].n1)) then 
                              SetEdgeBlack(i,j); // закрасить ребро 
               end; 
     end; 
end;