fork download
copy 
  1. {+--------------------------------------------------------------------------+}
  2. {|        The Textbook in Data Structure, Algorithms and Programming        |}
  3. {|              http://w...content-available-to-author-only...c.jp/~hoangle/DSAPTextbook/               |}
  4. {|                                                                          |}
  5. {|    Program: Finding_the_Minimum_Spanning_Tree_using_Kruskal_Algorithm    |}
  6. {|                         Written by Le Minh Hoang                         |}
  7. {|                      Email: dsaptextbook@gmail.com                       |}
  8. {+--------------------------------------------------------------------------+}
  9.  
  10. {$MODE DELPHI} (*This program uses 32-bit Integer [-2^31 .. 2^31 - 1]*)
  11. program Finding_the_Minimum_Spanning_Tree_using_Kruskal_Algorithm;
  12. (*
  13. IMPORTANT NOTES FOR COMPATIBILITY:
  14. ==================================
  15. - This program is especially written for running under Windows 32 bit and
  16.   Free Pascal IDE. Therefore, 32-bit Integer type is used to result in the
  17.   best performance with the {$MODE DELPHI} compiler directive of FPK for
  18.   Windows.
  19. - If you use Borland Turbo Pascal 7 for DOS, you may have to reduce the
  20.   data structure to deal with the limited memory. In addition, BP7 does not
  21.   support 32-bit Integer type, it causes some Integer variables would have
  22.   to be converted into LongInt variables.
  23. - If you prefer to compile under Delphi, you can simply convert the source
  24.   code as follows:
  25.   + Replace the type "Text" with the type "TextFile"
  26.   + Change all procedure calls "Assign(., .)" to "AssignFile(., .)" and
  27.     "Close(.)" to "CloseFile(.)"
  28.   + Remove the {$MODE DELPHI} and add the {$APPTYPE CONSOLE} compiler 
  29.     directive to the beginning of this program
  30. -----------------------------------------------------------------
  31. Please report any errors to: dsaptextbook@gmail.com, MANY THANKS!
  32. -----------------------------------------------------------------
  33. *)
  34. const
  35.   InputFile  = '';
  36.   OutputFile = '';
  37.   maxV = 1000;
  38.   maxE = (maxV - 1) * maxV div 2;
  39. type
  40.   TEdge = record    			
  41.     u, v, c: Integer;		
  42.     Mark: Boolean;			
  43.   end;
  44. var
  45.   e: array[1..maxE] of TEdge; 			
  46.   Lab: array[1..maxV] of Integer;		
  47.   n, m: Integer;
  48.   Connected: Boolean;
  49.  
  50. procedure LoadGraph;		
  51. var
  52.   i: Integer;
  53.   f: Text;
  54. begin
  55.   Assign(f, InputFile); Reset(f);
  56.   ReadLn(f, n, m);
  57.   for i := 1 to m do
  58.     with e[i] do
  59.       ReadLn(f, u, v, c);
  60.   Close(f);
  61. end;
  62.  
  63. procedure Init;
  64. var
  65.   i: Integer;
  66. begin
  67.   for i := 1 to n do Lab[i] := -1;			
  68.   for i := 1 to m do e[i].Mark := False;
  69. end;
  70.  
  71. function GetRoot(v: Integer): Integer;	
  72. begin
  73.   while Lab[v] > 0 do v := Lab[v];
  74.   GetRoot := v;
  75. end;
  76.  
  77. procedure Union(r1, r2: Integer);				
  78. var
  79.   x: Integer;
  80. begin
  81.   x := Lab[r1] + Lab[r2];
  82.   if Lab[r1] > Lab[r2] then
  83.     begin
  84.       Lab[r1] := r2;
  85.       Lab[r2] := x;
  86.     end
  87.   else
  88.     begin
  89.       Lab[r1] := x;
  90.       Lab[r2] := r1;
  91.     end;
  92. end;
  93.  
  94. procedure AdjustHeap(root, last: Integer);		
  95. var
  96.   Key: TEdge;
  97.   child: Integer;
  98. begin
  99.   Key := e[root];
  100.   while root * 2 <= Last do
  101.     begin
  102.       child := root * 2;
  103.       if (child < Last) and (e[child + 1].c < e[child].c)
  104.         then Inc(child);
  105.       if Key.c <= e[child].c then Break;
  106.       e[root] := e[child];
  107.       root := child;
  108.     end;
  109.   e[root] := Key;
  110. end;
  111.  
  112. procedure Kruskal;
  113. var
  114.   i, r1, r2, Count, a: Integer;
  115.   tmp: TEdge;
  116. begin
  117.   Count := 0;
  118.   Connected := False;
  119.   for i := m div 2 downto 1 do AdjustHeap(i, m);
  120.   for i := m - 1 downto 0 do
  121.     begin
  122.       tmp := e[1]; e[1] := e[i + 1]; e[i + 1] := tmp;
  123.       AdjustHeap(1, i);
  124.       r1 := GetRoot(e[i + 1].u); r2 := GetRoot(e[i + 1].v);
  125.       if r1 <> r2 then						
  126.         begin
  127.           e[i + 1].Mark := True;
  128.           Inc(Count);							
  129.           if Count = n - 1 then		
  130.             begin
  131.               Connected := True;
  132.               Exit;
  133.             end;
  134.           Union(r1, r2);					
  135.         end;
  136.     end;
  137. end;
  138.  
  139. procedure PrintResult;
  140. var
  141.   i, Count, W: Integer;
  142.   f: Text;
  143. begin
  144.   Assign(f, OutputFile); Rewrite(f);
  145.   if not Connected then
  146.     WriteLn(f, 'Error: Graph is not connected')
  147.   else
  148.     begin
  149.       WriteLn(f, 'Minimum spanning tree: ');
  150.       Count := 0;
  151.       W := 0;
  152.       for i := 1 to m do								
  153.         with e[i] do
  154.           begin
  155.             if Mark then								
  156.               begin
  157.                 WriteLn(f, '(', u, ', ', v, ') = ', c);
  158.                 Inc(Count);
  159.                 W := W + c;
  160.               end;
  161.             if Count = n - 1 then Break;		
  162.           end;
  163.       WriteLn(f, 'Weight = ', W);
  164.     end;
  165.   Close(f);
  166. end;
  167.  
  168. begin
  169.   LoadGraph;
  170.   Init;
  171.   Kruskal;
  172.   PrintResult;
  173. end.
  174.  
Runtime error #stdin #stdout #stderr 0s 8152KB
comments (?)
stdin
copy 
7 21
1 2 547152
1 3 509157
1 4 539282
1 5 541645         
1 6 458433
1 7 385173

2 3 131528
2 4 92735
2 5 150511
2 6 94440
2 7 194542
3 4 216600
3 5 272401
3 6 157176
3 7 124077
4 5 57785
4 6 97323
4 7 242232
5 6 136663
5 7 283862
6 7 147426
stdout
copy 
Standard output is empty
stderr
copy 
Runtime error 106 at $00000000004002CB
  $00000000004002CB
https://ideone.com/Oxy3Zf
language:
Pascal (fpc 3.0.4)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!