{+--------------------------------------------------------------------------+}
{| The Textbook in Data Structure, Algorithms and Programming |}
{| http://w...content-available-to-author-only...c.jp/~hoangle/DSAPTextbook/ |}
{| |}
{| Program: Finding_the_Minimum_Spanning_Tree_using_Kruskal_Algorithm |}
{| Written by Le Minh Hoang |}
{| Email: dsaptextbook@gmail.com |}
{+--------------------------------------------------------------------------+}
{$MODE DELPHI} (*This program uses 32-bit Integer [-2^31 .. 2^31 - 1]*)
program Finding_the_Minimum_Spanning_Tree_using_Kruskal_Algorithm;
(*
IMPORTANT NOTES FOR COMPATIBILITY:
==================================
- This program is especially written for running under Windows 32 bit and
Free Pascal IDE. Therefore, 32-bit Integer type is used to result in the
best performance with the {$MODE DELPHI} compiler directive of FPK for
Windows.
- If you use Borland Turbo Pascal 7 for DOS, you may have to reduce the
data structure to deal with the limited memory. In addition, BP7 does not
support 32-bit Integer type, it causes some Integer variables would have
to be converted into LongInt variables.
- If you prefer to compile under Delphi, you can simply convert the source
code as follows:
+ Replace the type "Text" with the type "TextFile"
+ Change all procedure calls "Assign(., .)" to "AssignFile(., .)" and
"Close(.)" to "CloseFile(.)"
+ Remove the {$MODE DELPHI} and add the {$APPTYPE CONSOLE} compiler
directive to the beginning of this program
-----------------------------------------------------------------
Please report any errors to: dsaptextbook@gmail.com, MANY THANKS!
-----------------------------------------------------------------
*)
const
InputFile = '';
OutputFile = '';
maxV = 1000;
maxE = (maxV - 1) * maxV div 2;
type
TEdge = record
u, v, c: Integer;
Mark: Boolean;
end;
var
e: array[1..maxE] of TEdge;
Lab: array[1..maxV] of Integer;
n, m: Integer;
Connected: Boolean;
procedure LoadGraph;
var
i: Integer;
f: Text;
begin
Assign(f, InputFile); Reset(f);
ReadLn(f, n, m);
for i := 1 to m do
with e[i] do
ReadLn(f, u, v, c);
Close(f);
end;
procedure Init;
var
i: Integer;
begin
for i := 1 to n do Lab[i] := -1;
for i := 1 to m do e[i].Mark := False;
end;
function GetRoot(v: Integer): Integer;
begin
while Lab[v] > 0 do v := Lab[v];
GetRoot := v;
end;
procedure Union(r1, r2: Integer);
var
x: Integer;
begin
x := Lab[r1] + Lab[r2];
if Lab[r1] > Lab[r2] then
begin
Lab[r1] := r2;
Lab[r2] := x;
end
else
begin
Lab[r1] := x;
Lab[r2] := r1;
end;
end;
procedure AdjustHeap(root, last: Integer);
var
Key: TEdge;
child: Integer;
begin
Key := e[root];
while root * 2 <= Last do
begin
child := root * 2;
if (child < Last) and (e[child + 1].c < e[child].c)
then Inc(child);
if Key.c <= e[child].c then Break;
e[root] := e[child];
root := child;
end;
e[root] := Key;
end;
procedure Kruskal;
var
i, r1, r2, Count, a: Integer;
tmp: TEdge;
begin
Count := 0;
Connected := False;
for i := m div 2 downto 1 do AdjustHeap(i, m);
for i := m - 1 downto 0 do
begin
tmp := e[1]; e[1] := e[i + 1]; e[i + 1] := tmp;
AdjustHeap(1, i);
r1 := GetRoot(e[i + 1].u); r2 := GetRoot(e[i + 1].v);
if r1 <> r2 then
begin
e[i + 1].Mark := True;
Inc(Count);
if Count = n - 1 then
begin
Connected := True;
Exit;
end;
Union(r1, r2);
end;
end;
end;
procedure PrintResult;
var
i, Count, W: Integer;
f: Text;
begin
Assign(f, OutputFile); Rewrite(f);
if not Connected then
WriteLn(f, 'Error: Graph is not connected')
else
begin
WriteLn(f, 'Minimum spanning tree: ');
Count := 0;
W := 0;
for i := 1 to m do
with e[i] do
begin
if Mark then
begin
WriteLn(f, '(', u, ', ', v, ') = ', c);
Inc(Count);
W := W + c;
end;
if Count = n - 1 then Break;
end;
WriteLn(f, 'Weight = ', W);
end;
Close(f);
end;
begin
LoadGraph;
Init;
Kruskal;
PrintResult;
end.
eystLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLSt9Cnt8ICAgICAgICBUaGUgVGV4dGJvb2sgaW4gRGF0YSBTdHJ1Y3R1cmUsIEFsZ29yaXRobXMgYW5kIFByb2dyYW1taW5nICAgICAgICB8fQp7fCAgICAgICAgICAgICAgaHR0cDovL3cuLi5jb250ZW50LWF2YWlsYWJsZS10by1hdXRob3Itb25seS4uLmMuanAvfmhvYW5nbGUvRFNBUFRleHRib29rLyAgICAgICAgICAgICAgIHx9Cnt8ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB8fQp7fCAgICBQcm9ncmFtOiBGaW5kaW5nX3RoZV9NaW5pbXVtX1NwYW5uaW5nX1RyZWVfdXNpbmdfS3J1c2thbF9BbGdvcml0aG0gICAgfH0Ke3wgICAgICAgICAgICAgICAgICAgICAgICAgV3JpdHRlbiBieSBMZSBNaW5oIEhvYW5nICAgICAgICAgICAgICAgICAgICAgICAgIHx9Cnt8ICAgICAgICAgICAgICAgICAgICAgIEVtYWlsOiBkc2FwdGV4dGJvb2tAZ21haWwuY29tICAgICAgICAgICAgICAgICAgICAgICB8fQp7Ky0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tK30KCnskTU9ERSBERUxQSEl9ICgqVGhpcyBwcm9ncmFtIHVzZXMgMzItYml0IEludGVnZXIgWy0yXjMxIC4uIDJeMzEgLSAxXSopCnByb2dyYW0gRmluZGluZ190aGVfTWluaW11bV9TcGFubmluZ19UcmVlX3VzaW5nX0tydXNrYWxfQWxnb3JpdGhtOwooKgpJTVBPUlRBTlQgTk9URVMgRk9SIENPTVBBVElCSUxJVFk6Cj09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT0KLSBUaGlzIHByb2dyYW0gaXMgZXNwZWNpYWxseSB3cml0dGVuIGZvciBydW5uaW5nIHVuZGVyIFdpbmRvd3MgMzIgYml0IGFuZAogIEZyZWUgUGFzY2FsIElERS4gVGhlcmVmb3JlLCAzMi1iaXQgSW50ZWdlciB0eXBlIGlzIHVzZWQgdG8gcmVzdWx0IGluIHRoZQogIGJlc3QgcGVyZm9ybWFuY2Ugd2l0aCB0aGUgeyRNT0RFIERFTFBISX0gY29tcGlsZXIgZGlyZWN0aXZlIG9mIEZQSyBmb3IKICBXaW5kb3dzLgotIElmIHlvdSB1c2UgQm9ybGFuZCBUdXJibyBQYXNjYWwgNyBmb3IgRE9TLCB5b3UgbWF5IGhhdmUgdG8gcmVkdWNlIHRoZQogIGRhdGEgc3RydWN0dXJlIHRvIGRlYWwgd2l0aCB0aGUgbGltaXRlZCBtZW1vcnkuIEluIGFkZGl0aW9uLCBCUDcgZG9lcyBub3QKICBzdXBwb3J0IDMyLWJpdCBJbnRlZ2VyIHR5cGUsIGl0IGNhdXNlcyBzb21lIEludGVnZXIgdmFyaWFibGVzIHdvdWxkIGhhdmUKICB0byBiZSBjb252ZXJ0ZWQgaW50byBMb25nSW50IHZhcmlhYmxlcy4KLSBJZiB5b3UgcHJlZmVyIHRvIGNvbXBpbGUgdW5kZXIgRGVscGhpLCB5b3UgY2FuIHNpbXBseSBjb252ZXJ0IHRoZSBzb3VyY2UKICBjb2RlIGFzIGZvbGxvd3M6CiAgKyBSZXBsYWNlIHRoZSB0eXBlICJUZXh0IiB3aXRoIHRoZSB0eXBlICJUZXh0RmlsZSIKICArIENoYW5nZSBhbGwgcHJvY2VkdXJlIGNhbGxzICJBc3NpZ24oLiwgLikiIHRvICJBc3NpZ25GaWxlKC4sIC4pIiBhbmQKICAgICJDbG9zZSguKSIgdG8gIkNsb3NlRmlsZSguKSIKICArIFJlbW92ZSB0aGUgeyRNT0RFIERFTFBISX0gYW5kIGFkZCB0aGUgeyRBUFBUWVBFIENPTlNPTEV9IGNvbXBpbGVyIAogICAgZGlyZWN0aXZlIHRvIHRoZSBiZWdpbm5pbmcgb2YgdGhpcyBwcm9ncmFtCi0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tClBsZWFzZSByZXBvcnQgYW55IGVycm9ycyB0bzogZHNhcHRleHRib29rQGdtYWlsLmNvbSwgTUFOWSBUSEFOS1MhCi0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tCiopCmNvbnN0CiAgSW5wdXRGaWxlICA9ICcnOwogIE91dHB1dEZpbGUgPSAnJzsKICBtYXhWID0gMTAwMDsKICBtYXhFID0gKG1heFYgLSAxKSAqIG1heFYgZGl2IDI7CnR5cGUKICBURWRnZSA9IHJlY29yZCAgICAJCQkKICAgIHUsIHYsIGM6IEludGVnZXI7CQkKICAgIE1hcms6IEJvb2xlYW47CQkJCiAgZW5kOwp2YXIKICBlOiBhcnJheVsxLi5tYXhFXSBvZiBURWRnZTsgCQkJCiAgTGFiOiBhcnJheVsxLi5tYXhWXSBvZiBJbnRlZ2VyOwkJCiAgbiwgbTogSW50ZWdlcjsKICBDb25uZWN0ZWQ6IEJvb2xlYW47Cgpwcm9jZWR1cmUgTG9hZEdyYXBoOwkJCnZhcgogIGk6IEludGVnZXI7CiAgZjogVGV4dDsKYmVnaW4KICBBc3NpZ24oZiwgSW5wdXRGaWxlKTsgUmVzZXQoZik7CiAgUmVhZExuKGYsIG4sIG0pOwogIGZvciBpIDo9IDEgdG8gbSBkbwogICAgd2l0aCBlW2ldIGRvCiAgICAgIFJlYWRMbihmLCB1LCB2LCBjKTsKICBDbG9zZShmKTsKZW5kOwoKcHJvY2VkdXJlIEluaXQ7CnZhcgogIGk6IEludGVnZXI7CmJlZ2luCiAgZm9yIGkgOj0gMSB0byBuIGRvIExhYltpXSA6PSAtMTsJCQkKICBmb3IgaSA6PSAxIHRvIG0gZG8gZVtpXS5NYXJrIDo9IEZhbHNlOwplbmQ7CgpmdW5jdGlvbiBHZXRSb290KHY6IEludGVnZXIpOiBJbnRlZ2VyOwkKYmVnaW4KICB3aGlsZSBMYWJbdl0gPiAwIGRvIHYgOj0gTGFiW3ZdOwogIEdldFJvb3QgOj0gdjsKZW5kOwoKcHJvY2VkdXJlIFVuaW9uKHIxLCByMjogSW50ZWdlcik7CQkJCQp2YXIKICB4OiBJbnRlZ2VyOwpiZWdpbgogIHggOj0gTGFiW3IxXSArIExhYltyMl07CiAgaWYgTGFiW3IxXSA+IExhYltyMl0gdGhlbgogICAgYmVnaW4KICAgICAgTGFiW3IxXSA6PSByMjsKICAgICAgTGFiW3IyXSA6PSB4OwogICAgZW5kCiAgZWxzZQogICAgYmVnaW4KICAgICAgTGFiW3IxXSA6PSB4OwogICAgICBMYWJbcjJdIDo9IHIxOwogICAgZW5kOwplbmQ7Cgpwcm9jZWR1cmUgQWRqdXN0SGVhcChyb290LCBsYXN0OiBJbnRlZ2VyKTsJCQp2YXIKICBLZXk6IFRFZGdlOwogIGNoaWxkOiBJbnRlZ2VyOwpiZWdpbgogIEtleSA6PSBlW3Jvb3RdOwogIHdoaWxlIHJvb3QgKiAyIDw9IExhc3QgZG8KICAgIGJlZ2luCiAgICAgIGNoaWxkIDo9IHJvb3QgKiAyOwogICAgICBpZiAoY2hpbGQgPCBMYXN0KSBhbmQgKGVbY2hpbGQgKyAxXS5jIDwgZVtjaGlsZF0uYykKICAgICAgICB0aGVuIEluYyhjaGlsZCk7CiAgICAgIGlmIEtleS5jIDw9IGVbY2hpbGRdLmMgdGhlbiBCcmVhazsKICAgICAgZVtyb290XSA6PSBlW2NoaWxkXTsKICAgICAgcm9vdCA6PSBjaGlsZDsKICAgIGVuZDsKICBlW3Jvb3RdIDo9IEtleTsKZW5kOwoKcHJvY2VkdXJlIEtydXNrYWw7CnZhcgogIGksIHIxLCByMiwgQ291bnQsIGE6IEludGVnZXI7CiAgdG1wOiBURWRnZTsKYmVnaW4KICBDb3VudCA6PSAwOwogIENvbm5lY3RlZCA6PSBGYWxzZTsKICBmb3IgaSA6PSBtIGRpdiAyIGRvd250byAxIGRvIEFkanVzdEhlYXAoaSwgbSk7CiAgZm9yIGkgOj0gbSAtIDEgZG93bnRvIDAgZG8KICAgIGJlZ2luCiAgICAgIHRtcCA6PSBlWzFdOyBlWzFdIDo9IGVbaSArIDFdOyBlW2kgKyAxXSA6PSB0bXA7CiAgICAgIEFkanVzdEhlYXAoMSwgaSk7CiAgICAgIHIxIDo9IEdldFJvb3QoZVtpICsgMV0udSk7IHIyIDo9IEdldFJvb3QoZVtpICsgMV0udik7CiAgICAgIGlmIHIxIDw+IHIyIHRoZW4JCQkJCQkKICAgICAgICBiZWdpbgogICAgICAgICAgZVtpICsgMV0uTWFyayA6PSBUcnVlOwogICAgICAgICAgSW5jKENvdW50KTsJCQkJCQkJCiAgICAgICAgICBpZiBDb3VudCA9IG4gLSAxIHRoZW4JCQogICAgICAgICAgICBiZWdpbgogICAgICAgICAgICAgIENvbm5lY3RlZCA6PSBUcnVlOwogICAgICAgICAgICAgIEV4aXQ7CiAgICAgICAgICAgIGVuZDsKICAgICAgICAgIFVuaW9uKHIxLCByMik7CQkJCQkKICAgICAgICBlbmQ7CiAgICBlbmQ7CmVuZDsKCnByb2NlZHVyZSBQcmludFJlc3VsdDsKdmFyCiAgaSwgQ291bnQsIFc6IEludGVnZXI7CiAgZjogVGV4dDsKYmVnaW4KICBBc3NpZ24oZiwgT3V0cHV0RmlsZSk7IFJld3JpdGUoZik7CiAgaWYgbm90IENvbm5lY3RlZCB0aGVuCiAgICBXcml0ZUxuKGYsICdFcnJvcjogR3JhcGggaXMgbm90IGNvbm5lY3RlZCcpCiAgZWxzZQogICAgYmVnaW4KICAgICAgV3JpdGVMbihmLCAnTWluaW11bSBzcGFubmluZyB0cmVlOiAnKTsKICAgICAgQ291bnQgOj0gMDsKICAgICAgVyA6PSAwOwogICAgICBmb3IgaSA6PSAxIHRvIG0gZG8JCQkJCQkJCQogICAgICAgIHdpdGggZVtpXSBkbwogICAgICAgICAgYmVnaW4KICAgICAgICAgICAgaWYgTWFyayB0aGVuCQkJCQkJCQkKICAgICAgICAgICAgICBiZWdpbgogICAgICAgICAgICAgICAgV3JpdGVMbihmLCAnKCcsIHUsICcsICcsIHYsICcpID0gJywgYyk7CiAgICAgICAgICAgICAgICBJbmMoQ291bnQpOwogICAgICAgICAgICAgICAgVyA6PSBXICsgYzsKICAgICAgICAgICAgICBlbmQ7CiAgICAgICAgICAgIGlmIENvdW50ID0gbiAtIDEgdGhlbiBCcmVhazsJCQogICAgICAgICAgZW5kOwogICAgICBXcml0ZUxuKGYsICdXZWlnaHQgPSAnLCBXKTsKICAgIGVuZDsKICBDbG9zZShmKTsKZW5kOwoKYmVnaW4KICBMb2FkR3JhcGg7CiAgSW5pdDsKICBLcnVza2FsOwogIFByaW50UmVzdWx0OwplbmQuCg==