Алгоритмы Прима и Крускала

Реализуем вышеописанные алгоритмы на практике с помощью Delphi 7. 

       
 
 
 
 
 
 
 
 

     Программный код 

     program Project1; 

     uses

      Forms,

      Unit1 in 'Unit1.pas' {Main},

      Unit2 in 'Unit2.pas' {AboutBox}; 

     {$R *.res} 

     begin

      Application.Initialize;

      Application.CreateForm(TMain, Main);

      Application.CreateForm(TAboutBox, AboutBox);

      Application.Run;

     end. 
 

     unit Unit1; 

     interface 

     uses

      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

      Dialogs, StdCtrls, Unit2, Menus; 

     type

      TRebro = record

      Fst,Lst,Vs:byte;

      end;

      Gr = array[1..256] of TRebro;

      TVect = array[1..256] of byte;

      TMain = class(TForm)

      Label1: TLabel;

      Label2: TLabel;

      Button2: TButton;

      Label3: TLabel;

      Label4: TLabel;

      Button3: TButton;

      Label5: TLabel;

      Label6: TLabel;

      Label7: TLabel;

      Label8: TLabel;

      Label9: TLabel;

      Label10: TLabel;

      Label11: TLabel;

      Label12: TLabel;

      Label13: TLabel;

      Label14: TLabel;

      Label15: TLabel;

      Label16: TLabel;

      Label17: TLabel;

      MainMenu1: TMainMenu;

      N1: TMenuItem;

      N2: TMenuItem;

      N3: TMenuItem;

      N4: TMenuItem;

      Label18: TLabel;

      Label19: TLabel;

      procedure FormCreate(Sender: TObject); 

      procedure Button2Click(Sender: TObject);

      procedure Button3Click(Sender: TObject);

      procedure N2Click(Sender: TObject);

      procedure N4Click(Sender: TObject);

      private

      { Private declarations }

      public

      { Public declarations }

      end; 

     var

      Main: TMain;

      X:GR;

      Mark:TVect;

       R,V:byte;//кол-во ребер и вершин соответственно

     procedure LoadGraph; 

     implementation 

     {$R *.dfm}

     Function Timer:longint;

      const c60:longint=60;

      var h,m,s,s100:word;

     begin

      decodetime(now,h,m,s,s100);

      timer:=((h*c60+m)*c60+s)*100+s100;

     end;

     procedure LoadGraph;

      var f:textfile;

      i:byte;

     begin

      i:=1;

      Assignfile(f,'dan.txt');

      Reset(f);

      R:=0;

      V:=0;

      Readln(f,R,V);

      while not eof(f) do

      begin

      Readln(f,X[i].Fst,X[i].Lst,X[i].Vs);

      Main.Label2.Caption:=Main.Label2.Caption+IntToStr(X[i].Fst)+' '+IntToStr(X[i].Lst)+

      ' '+IntToStr(X[i].Vs)+#13;

      inc(i);

      end;

      end; 

     procedure TMain.FormCreate(Sender: TObject);

     begin

      LoadGraph;

     end; 

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

     procedure TMain.Button2Click(Sender: TObject);

      var j,k,v2,Ves_gr:byte;

      t1,t2,t,Sr,Pr:longint;

      Tk:real; Y:Gr; 

      procedure UniteComponents(a,b:byte);

      var i:byte;

      begin

      If a>b then begin inc(sr);Pr:=Pr+3;i:=a; a:=b; b:=i; end else inc(sr);

      for i:=1 to V do

      If Mark[i] = b then begin Mark[i]:=a;inc(pr);end;

      Sr:=Sr+V;

      end; 

      procedure SortRebr(var X:Gr);

      var i,n,j,numb:integer; Mx:TRebro;

      begin

      N:=R;

      for i:=1 to R-1 do

      begin

      Mx:=X[1];

      numb:=1;

      Pr:=Pr+2;

      For j:=2 to N do

      If X[j].Vs>Mx.Vs then

      begin

      inc(Sr);

      Pr:=Pr+2;

      Mx:=X[j];

      numb:=j;

      end

      else inc(sr);

      X[numb]:=X[N];

      X[N]:=Mx;

      N:=N-1;

      pr:=Pr+3;

      end;

      end; 
 

     begin

      Y:=X;

      t:=0;

      for k:=1 to 100 do

      begin

      Sr:=0; //кол-во сравнений

       Pr:=0; //кол-во присваиваний

       Ves_gr:=0;

      SortRebr(X);

      Label3.Caption:='';

      t1:=timer;

      for v2:=1 to V do

      Mark[v2]:=v2;

      for j:=1 to R do

      If Mark[X[j].Fst]<>Mark[X[j].Lst] Then

      Begin

      Label3.Caption:=Label3.Caption+IntToStr(X[j].Fst)+' '+IntToStr(X[j].Lst)+

      ' '+IntToStr(X[j].Vs)+#13;

      inc(sr);

      Ves_gr:=Ves_gr+X[j].Vs; 

      UniteComponents(Mark[X[j].Fst],Mark[X[j].Lst]);

      end

      else inc(Sr);

      t2:=timer;

      T:=t+t2-t1;

      label12.Caption:=inttostr(Ves_gr);

      label14.Caption:=inttostr(Pr);

      label16.Caption:=inttostr(Sr); 

      X:=Y;

      end;

      Tk:=abs(t/100);

      label6.Caption:=FloatToStr(Tk)+'*0.01 c';

     end; 

     //Алгоритм  Прима 

     procedure TMain.Button3Click(Sender: TObject);

      const MaxVes=255;

      var Mark:array[1..10] of boolean;

      D,Res:array[1..10] of byte;

      i,j,imin,min,k:byte;

      t1,t2,t,Sr,Pr,Ves_gr:longint; TP:real; 

      Function FindVes(i,j:byte):byte;

      var k:byte;

      begin

      k:=0;

      Repeat

      inc(k);

      Until (k>16) or

      ( (X[k].Fst=i) and (X[k].Lst=j) )

      or( (X[k].Fst=j) and (X[k].Lst=i) );

      if k>16 then FindVes:=255 else

      FindVes:=X[k].Vs;

      end; 

      Function Aps(i,j:byte; var Ves:byte):boolean;

      var k:byte;

      begin

      k:=0; inc(pr);

      Repeat

      inc(k); inc(pr);

      Until (k>R) or

      ( (X[k].Fst=i) and (X[k].Lst=j) )

      or( (X[k].Fst=j) and (X[k].Lst=i) );

      if k>R then begin inc(sr);Aps:=false; end else

      begin inc(sr);pr:=pr+2;Ves:=X[k].Vs; Aps:=true end;

      end; 

      Procedure Calc(i : byte);

      Var j : byte;

      Begin

      For j := 1 To V Do

      If Not Mark[j] Then

      If Aps(i,j,D[j]) Then begin Res[j] := i; inc(pr);end;

      inc(sr);

      End; 

     begin

      t:=0;

     for k:=1 to 100 do

     begin

      Sr:=0;

      Pr:=0;

      Ves_gr:=0;

      t1:=timer;

      Label7.Caption:='';

      For i := 1 To V Do begin

      D[i] := MaxVes; Mark[i]:=false;end;

      Pr:=2*V;

      Mark[4] := True;

      Calc(4);

      For j := 1 To V-1 Do Begin { каркас состоит из n-1 ребер }

      min := MaxVes; inc(pr);

      For i := 1 To V Do

      If Not Mark[i] Then

      If min > D[i] Then Begin

      Sr:=Sr+2; Min := D[i]; imin := i; pr:=pr+2;

      End

      else sr:=Sr+2

      else inc(sr);

      Mark[imin] := True;

      Calc(imin);

      pr:=pr+2;

      ves_gr:=ves_gr+FindVes(imin,Res[imin]);

      

      label7.Caption:=Label7.Caption+IntToStr(imin)+' '+IntToStr(Res[imin])+