Правила форума
ВНИМАНИЕ!
Она по алгоритму Крускала, а вот насчет леса...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Grids;
type
TDerevo = object
mat: array[1..100] of array[1..100] of real;
procedure Add(i,j: integer; r: real);
end;
TForm1 = class(TForm)
Image1: TImage;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
Edit4: TEdit;
Label4: TLabel;
StringGrid1: TStringGrid;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
d: TDerevo;
st: integer;
stt: integer;
mat2: array[1..100] of array[1..2] of integer;
i1,j1,sch,t: integer;
b: real;
e: real;
sr,sch1: byte;
mark: array[1..100] of integer;
mat1: array[1..100] of array[1..3] of integer;
procedure poisk(j: integer);
procedure al_boruvki;
procedure vivod_2;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.Canvas.Ellipse(x-5,y-5,x+5,y+5);
st:= st+1;
Image1.Canvas.TextOut(x-20,y-10,inttostr(st));
mat2[st,1]:= x;
mat2[st,2]:= y;
end;
procedure TDerevo.Add;
begin
mat[i,j]:= r;
mat[j,i]:= r;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
stt:= stt+1;
StringGrid1.RowCount:= st*(st-1);
if (strtoint(Edit2.Text)<=st)and(strtoint(Edit3.Text)<=st)and(strtoint(Edit2.Text)<>strtoint(Edit3.Text)) then begin
d.Add(strtoint(Edit2.Text),strtoint(Edit3.Text),strtofloat(Edit1.Text));
Image1.Canvas.MoveTo(mat2[strtoint(Edit2.Text),1],mat2[strtoint(Edit2.Text),2]);
Image1.Canvas.LineTo(mat2[strtoint(Edit3.Text),1],mat2[strtoint(Edit3.Text),2]);
StringGrid1.Cells[1,stt]:= Edit2.Text;
StringGrid1.Cells[2,stt]:= Edit3.Text;
StringGrid1.Cells[3,stt]:= Edit1.Text;
end;
end;
procedure TForm1.poisk(j: integer);
var i,k: integer;
boo: boolean;
begin
for i:= 1 to st do
begin
if (d.mat[j,i]=-1*(sch-1)) and (sch<>1) then
begin
for k:= 1 to st*st do
begin
if mark[k]=0 then
begin
boo:= false;
mark[k]:= j;
mark[k+1]:=i;
break;
end;
if (mark[k]=i) then
begin
boo:= true;
break;
end;
end;
d.mat[j,i]:=0;
if boo= false then poisk(i);
end;
if (d.mat[j,i]<>0)and(d.mat[j,i]>0) then
if (b=0) or (b>d.mat[j,i]) then
begin
b:= d.mat[j,i];
i1:= i;
j1:= j;
{if (d.mat[j,i]<>-1*(sch-1)) or (sch=1) then break;}
end;
end;
end;
procedure TForm1.al_boruvki;
var i,k,j: integer;
begin
for i:= 1 to st*st do
mark[i]:=0;
k:=0;
t:=1;
i1:=0;
j1:=0;
b:=0;
sch:=1;
while true do
begin
for j:= 1 to st do
begin
for k:=1 to st*st do
begin
if (mark[k]=j)or((k=st*st)and(j=st)) then break;
if mark[k]=0 then
begin
poisk(j);
if d.mat[i1,j1]<>-1*sch then e:=e+d.mat[j1,i1];
d.mat[j1,i1]:= -1*sch;
b:= 0;
if (sch=1)and(j=1) then
begin
mat1[1,1]:=j1;
mat1[1,2]:=i1;
mat1[1,3]:=sch;
end else
begin
for i:=1 to st*st do
if mat1[i,1]<>0 then
if ((mat1[i,1]=j1)and(mat1[i,2]=i1))or((mat1[i,1]=i1)and(mat1[i,2]=j1))then
sch:= -1*sch else else break;
mat1[i,1]:=j1;
mat1[i,2]:=i1;
mat1[i,3]:=abs(sch);
if sch>0 then inc(t) else sch:= -1*sch;
end;
break;
end;
end;
end;
for i:= 1 to st do
for j:= 1 to st do
if d.mat[i,j]=-1*sch then
if d.mat[j,i]<>-1*sch then d.mat[j,i]:=-1*sch;
inc(sch);
if t=st-1 then break;
end;
end;
Procedure TForm1.vivod_2;
var
i1,j1: integer;
begin
if sch1=0 then
begin
sch:= 1;
sch1:=1;
sr:=mat1[sch,3];
end;
{while mat1[sch,3]=sr do}
begin
if sr=mat1[sch,3] then
begin
while mat1[sch,3]=sr do
begin
i1:=mat2[mat1[sch,1],1]-(mat2[mat1[sch,1],1]-mat2[mat1[sch,2],1])div 4;
j1:=mat2[mat1[sch,1],2]-(mat2[mat1[sch,1],2]-mat2[mat1[sch,2],2])div 4;
Image1.Canvas.Pen.Color:= clRed;
Image1.Canvas.MoveTo(mat2[mat1[sch,1],1],mat2[mat1[sch,1],2]);
Image1.Canvas.LineTo(i1,j1);
inc(sch);
end;
end else
begin
{KeyPress(char(13));}
{readkey;}
while sr=mat1[sch1,3] do
begin
Image1.Canvas.Pen.Color:= clRed;
Image1.Canvas.MoveTo(mat2[mat1[sch1,1],1],mat2[mat1[sch1,1],2]);
Image1.Canvas.LineTo(mat2[mat1[sch1,2],1],mat2[mat1[sch1,2],2]);
inc(sch1);
end;
sr:=mat1[sch,3];
{inc(sch);}
{readkey;}
{continue; }
end;
{inc(sch);}
end;
{if mat1[sch,3]=0 then
begin
sch:= sch-1;
sch1:= sch;
sr:= mat1[sch,3];
While sr=mat1[sch1,3] do
begin
Image1.Canvas.Pen.Color:= clRed;
Image1.Canvas.MoveTo(mat2[mat1[sch1,1],1],mat2[mat1[sch1,1],2]);
Image1.Canvas.LineTo(mat2[mat1[sch1,2],1],mat2[mat1[sch1,2],2]);
dec(sch1);
end;
end; }
end;
procedure TForm1.Button2Click(Sender: TObject);
var i: integer;
j: real;
begin
al_boruvki;
Edit4.Text:= floattostr(e);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
vivod_2;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
stt:= 0;
st:= 0;
end;
end.
Как происходит поиск - на картинке, вся программа в архиве
