Код: Алгоритм Краскала
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;
Сільвейстр Богдан, Паламар Максим, Майданюк Артем
This site was made on Tilda — a website builder that helps to create a website without any code
Create a website