📄 unit1.pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, OleCtrls, VCFI, OleServer, Excel2000;
type
matrix=array[1..10,1..10]of integer;
tedge=record
a,b:integer;
c:integer;
end;
matrix1=array[1..10]of integer;
var
edges:array[1..10] of tedge;
weight:matrix; {matrix for the weight of each edge}
weightmax,first,last:integer; {infinity}
distance:matrix1; {distances between the first a node and each vertex}
node:matrix1; {previous vertex list}
maxnode:integer;
type
TForm1 = class(TForm)
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Edit3: TEdit;
SG: TStringGrid;
Memo1: TMemo;
Label2: TLabel;
Button1: TButton;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Memo2: TMemo;
Label10: TLabel;
procedure inicialize (var paredges:array of tedge;var parweight:matrix;var parfirst,parlast:integer);
procedure calculate(parweight:matrix; var pardistance, parnode:array of integer;weightmax:integer);
procedure calculate2(parweight:matrix; var pardistance, parnode:array of integer;weightmax:integer;row,column:integer);
procedure Button2Click(Sender: TObject);
procedure Edit3Exit(Sender: TObject);
procedure Edit3KeyPress(Sender: TObject; var Key: Char);
procedure SGKeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure tform1.inicialize (var paredges:array of tedge;var parweight:matrix;var parfirst,parlast:integer);
var
I,J,k,w,temp1,temp2,temp3:integer;
destination:array[1..10] of integer;
begin
for I:=0 to 50 do
begin
paredges[I].a:=0;
paredges[I].b:=0;
paredges[I].c:=0;
end;
weightmax:=1;
for I:=1 to 10 do
for J:=1 to 10 do
parweight[I,J]:=weightmax;
for I:=0 to 9 do
for J:=0 to 9 do
begin
if SG.Cells[J,I]='' then
parweight[I+1,J+1]:=0
else
begin
temp1:=strtoint(SG.cells[J,I]);
parweight[I+1,J+1]:=temp1;
end;
end;
k:=1;
for I:=1 to 10 do
for J:=I to 10 do
begin
if (parweight[I,J]<>0) and (I<>J) then
begin
paredges[k].a:=I;
paredges[k].b:=J;
paredges[k].c:=parweight[I,J];
k:=k+1
end;
end;
for I:=1 to 10 do
weightmax:=weightmax + paredges[I].c;
// weightmax:=13;
for I:=0 to 9 do
for J:=0 to 9 do
begin
if (SG.Cells[J,I]='') or (I=J) or (parweight[I+1,J+1]=0) then
parweight[I+1,J+1]:=weightmax;
end;
end;
procedure TForm1.calculate(parweight:matrix; var pardistance, parnode:array of integer;weightmax:integer);
var
I,K,S,J,Y,dist,Dmin,Kmin,t,p,pp,parlast,Error,w,ww:integer;
nodebis:array[1..10]of integer;
matrix:array[1..10,1..10] of integer;
matrixpre:array[1..10,1..10] of integer;
destination:array[1..10] of integer;
time:array[1..100] of integer;
begin //1
t:=0; //neda
Error:=1;
edit1.Clear;
destination[1]:=5;
destination[2]:=5;
destination[3]:=1;
destination[4]:=2;
destination[5]:=1;
destination[6]:=5;
destination[7]:=8;
destination[8]:=3;
destination[9]:=5;
destination[10]:=2;
for I:=1 to 10 do
begin //2
parnode[i]:=0;
pardistance[i]:=weightmax;
end; //2 {for now, only the first node is in the list}
for Y:=1 to 10 do begin //neda
parnode[Y]:=Y;
parlast:=destination[Y];
pardistance[Y]:=0;
S:=1;
nodebis[1]:=Y;
repeat ///////////********** {new i: minimun distance}
Kmin:=S;
I:=nodebis[S];
Dmin:=pardistance[i];
for K:=1 to S-1 do
begin //3
J:=nodebis[K];
Dist:=pardistance[J];
if (Dist<Dmin) then
begin //4
Kmin:=K;
I:=J;
Dmin:=Dist;
end; //4
end; //3
if (I<>last) then
begin //5
nodebis[Kmin]:=nodebis[S];
S:=S-1; {see other nodes around i}
for J:=1 to 10 do
if (pardistance[i] + parweight[I,J]<pardistance[J])then
begin //6
if (pardistance[J]=weightmax) then
begin //7
S:=S+1; {add j to the list}
nodebis[S]:=J;
end; //7 {update}
pardistance[J]:=pardistance[i]+parweight[I,J];
edit1.Text:=edit1.Text+ inttostr(pardistance[J])+' ';
for w:=1 to 10 do
for ww:=1 to 10 do
matrixpre[w,ww]:=matrix[w,ww];
matrix[Y,J]:=pardistance[J];
for w:=1 to 10 do
for ww:=1 to 10 do
if matrix[w,ww]<>matrixpre[w,ww] then
Error:=0;
if Error=1 then
begin
showmessage(inttostr(t));
Exit;
end;
parnode[J]:=I;
end; //6
end; //5
t:=t+1;
time[t]:=t;
until (I=parlast) or (S=0); ///////////**********
edit1.Text:=edit1.Text+'**';
for pp:=1 to 10 do
begin
parnode[pp]:=0;
pardistance[pp]:=weightmax;
end;
end;
memo1.Clear;
for p:=1 to 10 do
begin
for pp:=1 to 10 do
begin
edit2.text:=edit2.text+inttostr(matrix[p,pp])+' ';
memo1.Text:=memo1.Text+ inttostr(matrix[p,pp])+' ';
end;
edit2.text:=edit2.text+'**';
memo1.text:=memo1.Text+' ';
end;
showmessage('time of converge ='+ inttostr(t));
end;//1
procedure TForm1.Button2Click(Sender: TObject);
begin
memo1.Visible:=true;
inicialize(edges,weight,first,last);
calculate(weight,distance,node,weightmax);
end;
procedure TForm1.Edit3Exit(Sender: TObject);
begin
if edit3.text='' then
begin
showmessage('please enter correct number');
exit;
end;
Maxnode:=strtoint(edit3.Text);
end;
procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
if key=chr(13) then
Button2.SetFocus;
end;
procedure TForm1.SGKeyPress(Sender: TObject; var Key: Char);
begin
if key=chr(13) then
Button2.SetFocus;
end;
procedure TForm1.calculate2(parweight:matrix; var pardistance, parnode:array of integer;weightmax:integer;row,column:integer);
var
I,K,S,J,Y,dist,Dmin,Kmin,t,p,pp,parlast,Error,w,ww:integer;
nodebis:array[1..10]of integer;
matrix:array[1..10,1..10] of integer;
matrixpre:array[1..10,1..10] of integer;
destination:array[1..10] of integer;
begin //1
parweight[row,column]:=weightmax ;
parweight[column,row]:=weightmax ;
t:=0;
Error:=1;
edit1.Clear;
destination[1]:=5;
destination[2]:=5;
destination[3]:=1;
destination[4]:=2;
destination[5]:=1;
destination[6]:=5;
destination[7]:=8;
destination[8]:=3;
destination[9]:=5;
destination[10]:=2;
for I:=1 to 10 do
begin //2
parnode[i]:=0;
pardistance[i]:=weightmax;
end; //2 {for now, only the first node is in the list}
for Y:=1 to 10 do begin
parnode[Y]:=Y;
parlast:=destination[Y];
pardistance[Y]:=0;
S:=1;
nodebis[1]:=Y;
repeat ///////////********** {new i: minimun distance}
Kmin:=S;
I:=nodebis[S];
Dmin:=pardistance[i];
for K:=1 to S-1 do
begin //3
J:=nodebis[K];
Dist:=pardistance[J];
if (Dist<Dmin) then
begin //4
Kmin:=K;
I:=J;
Dmin:=Dist;
end; //4
end; //3
if (I<>last) then
begin //5
nodebis[Kmin]:=nodebis[S];
S:=S-1; {see other nodes around i}
for J:=1 to 10 do
if (pardistance[i] + parweight[I,J]<pardistance[J])then
begin //6
if (pardistance[J]=weightmax) then
begin //7
S:=S+1; {add j to the list}
nodebis[S]:=J;
end; //7 {update}
pardistance[J]:=pardistance[i]+parweight[I,J];
edit1.Text:=edit1.Text+ inttostr(pardistance[J])+' ';
for w:=1 to 10 do
for ww:=1 to 10 do
matrixpre[w,ww]:=matrix[w,ww];
matrix[Y,J]:=pardistance[J];
for w:=1 to 10 do
for ww:=1 to 10 do
if matrix[w,ww]<>matrixpre[w,ww] then
Error:=0;
if Error=1 then
begin
showmessage(inttostr(t));
Exit;
end;
parnode[J]:=I;
end; //6
end; //5
t:=t+1;
until (I=parlast) or (S=0); ///////////**********
edit1.Text:=edit1.Text+'**';
for pp:=1 to 10 do
begin
parnode[pp]:=0;
pardistance[pp]:=weightmax;
end;
end;
memo2.Clear;
for p:=1 to 10 do
begin
for pp:=1 to 10 do
begin
edit2.text:=edit2.text+inttostr(matrix[p,pp])+' ';
memo2.Text:=memo2.Text+ inttostr(matrix[p,pp])+' ';
end;
edit2.text:=edit2.text+'**';
memo2.text:=memo2.Text+' ';
end;
showmessage('time of converge after reconstruction'+inttostr(t));
end;//1
procedure TForm1.Button1Click(Sender: TObject);
var I,J:integer;
begin
memo2.Visible:=true;
I:=strtoint(edit4.text);
J:=strtoint(edit5.text);
calculate2(weight,distance,node,weightmax,I,J);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -