Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls, Grids;
type
TForm1 = class(TForm)
UpDown1: TUpDown;
Edit1: TEdit;
Label1: TLabel;
Panel1: TPanel;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Button1: TButton;
Memo1: TMemo;
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure FormShow(Sender: TObject);
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure StringGrid2SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid2KeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Init( nomer:integer);
procedure muravei(o:integer);
private
{ Private declarations }
public
{ Public declarations }
end;
const
max_count = 100; //максимальное колличество вершин
t_max=100; // время жизни колонии
var
Form1 : TForm1;
count : integer;
tau,p : array[1..max_count, 1..max_count] of double;
// матрица , указывает какие точки еще не прошел муравей
q : array[1..max_count, 1..max_count] of boolean;
// матрица указывает , последовательность прохождения точек
t,l : array[1..max_count, 1..max_count] of integer;
tm,dt : array[1..max_count] of integer;
dtm : integer; //
implementation
{$R *.dfm}
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
var
i:integer;
begin
//количество вершин
count := form1.UpDown1.Position;
form1.StringGrid1.ColCount := count + 1;
form1.StringGrid1.RowCount := count + 1;
form1.StringGrid2.ColCount := count + 1;
form1.StringGrid2.RowCount := count + 1;
for i:=1 to count do
begin
form1.StringGrid1.Cells[i,0] := IntToStr(i);
form1.StringGrid1.Cells[0,i] := IntToStr(i);
form1.StringGrid1.Cells[i,i]:='****';
form1.StringGrid2.Cells[i,0] := IntToStr(i);
form1.StringGrid2.Cells[0,i] := IntToStr(i);
form1.StringGrid2.Cells[i,i]:='****';
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
i:integer;
begin
form1.UpDown1.Max := max_count;
form1.UpDown1.min := 2;
count := form1.UpDown1.Position;
form1.Edit1.Text:=IntToStr(count);
form1.StringGrid1.ColCount:=count+1;
form1.StringGrid1.RowCount:=count+1;
form1.StringGrid2.ColCount:=count+1;
form1.StringGrid2.RowCount:=count+1;
for i:=1 to count do
begin
form1.StringGrid1.Cells[i,0] := IntToStr(i);
form1.StringGrid1.Cells[0,i] := IntToStr(i);
form1.StringGrid1.Cells[i,i]:='****';
form1.StringGrid2.Cells[i,0] := IntToStr(i);
form1.StringGrid2.Cells[0,i] := IntToStr(i);
form1.StringGrid2.Cells[i,i]:='****';
end;
end;
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
if acol=arow then form1.StringGrid1.Cells[acol,arow]:='****' ;
form1.StringGrid1.Cells[arow,acol]:=form1.StringGrid1.Cells[acol,arow];
end;
procedure TForm1.StringGrid2SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
if acol=arow then form1.StringGrid2.Cells[acol,arow]:='****' ;
form1.StringGrid2.Cells[arow,acol]:=form1.StringGrid2.Cells[acol,arow];
end;
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in [chr(8),'0','1','2','3','4','5','6','7','8','9']) then key:=#0;
end;
procedure TForm1.StringGrid2KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in [chr(8),',','0','1','2','3','4','5','6','7','8','9']) then key:=#0;
end;
procedure TForm1.Init(nomer:integer);
var
i:integer;
begin
// какие точки ему еще осталость пройти
for i:=1 to count do
q[nomer,i]:=true;
q[nomer,nomer]:=false;
//от куда муравей идет
for i:=1 to count do
t[nomer,i]:=0;
t[nomer,1]:=nomer;
end;
procedure TForm1.muravei(o:integer);
var
i,h,k :integer;
z,cheslo :double;
begin
init(o);
for h:=1 to count -1 do
begin
// знаминатель из P
z:=0;
for i:=1 to count do
if q[o,i] then
z := z + tau[o,i]/l[o,i];
// формула Р
for i:=1 to count do
if q[o,i] then
p[o,i] :=100* tau[o,i]/l[o,i] / z;
cheslo:=0;
for i:=1 to count do
if q[o,i] then
begin
cheslo := cheslo + p[o,i];
p[o,i] := cheslo;
end;
z:= random(10000)/100;
k:=0;
for i:=1 to count do
if q[o,i] then
if z< p[o,i] then
begin
k:=i;
break;
end;
// k - то точка куда муравей перемещается
q[o,k]:=false;
i:=1;
while t[o,i]<>0 do
inc(i);
// записываем номер
t[o,i]:=k;
end;
//вычесляем путь
k:= 0;
for i:=1 to count-1 do
k:=k+l[t[o,i],t[o,i+1]];
k:=k+l[t[o,1],t[o,count]];
//запомнили значение
dt[o]:=k;
// for i:=1 to count do
// form1.Memo1.Lines.Add(IntToStr(t[o,i]));
// form1.Memo1.Lines.Add('длина ровна'+FloatToStr(k));
end;
procedure TForm1.Button1Click(Sender: TObject);
var datetime1,datetime2:TDateTime;
st1: string;
i,j,k :integer;
begin
dateTime1:=Time;
randomize;
for i:=1 to count do
for j:=1 to count do
if i<>j then l[i,j]:=StrToINt(form1.StringGrid1.Cells[i,j])
else l[i,j]:=0;
for i:=1 to count do
for j:=1 to count do
if i<>j then tau[i,j]:=StrToFloat(form1.StringGrid2.Cells[i,j])
else tau[i,j]:=0;
//запускаем первого муравья
muravei(1);
//записваем его результаты
for i:=1 to count do
tm[i]:=t[1,i];
dtm:=dt[1];
for k:=1 to t_max do
begin
for i:=1 to count do
init (i);
for i:=1 to count do
muravei(i);
// если нашли лучшей результат , то записаваем его
for i:=1 to count do
if dtm > dt [i] then
begin
for j:=1 to count do
tm[j]:=t[i,j];
dtm:=dt[i];
// timer1.Interval:=timer1.Interval+1;
end;
for i:=1 to count-1 do
begin
tau[tm[i],tm[i+1]]:=tau[tm[i],tm[i+1]]+1/dtm;
tau[tm[i+1],tm[i]]:=tau[tm[i],tm[i+1]];
//timer1.Interval:=timer1.Interval+1;
end;
tau[tm[1],tm[count]]:=tau[tm[1],tm[count]]+1/dtm;
tau[tm[count],tm[1]]:=tau[tm[1],tm[count]];
for i:=1 to count do
for j:=1 to count do
form1.StringGrid2.Cells[i,j]:=FloatToStr(tau[i,j]);
end;
form1.Memo1.Clear;
for i:=1 to count do
form1.Memo1.Lines.Add(IntToStr(tm[i]));
form1.Memo1.Lines.Add('длина равна '+FloatToStr(dtm));
dateTime2:=Time;
str(8640000*(DateTime2-DateTime1):3:5,st1) ;
caption:=st1+'ms';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.UpDown1.Position:=5;
form1.StringGrid1.Cells[1,2]:=IntToStr(38);
form1.StringGrid1.Cells[1,3]:=IntToStr(74);
form1.StringGrid1.Cells[1,4]:=IntToStr(59);
form1.StringGrid1.Cells[1,5]:=IntToStr(45);
form1.StringGrid1.Cells[2,1]:=IntToStr(38);
form1.StringGrid1.Cells[2,3]:=IntToStr(46);
form1.StringGrid1.Cells[2,4]:=IntToStr(61);
form1.StringGrid1.Cells[2,5]:=IntToStr(72);
form1.StringGrid1.Cells[3,1]:=IntToStr(74);
form1.StringGrid1.Cells[3,2]:=IntToStr(46);
form1.StringGrid1.Cells[3,4]:=IntToStr(49);
form1.StringGrid1.Cells[3,5]:=IntToStr(85);
form1.StringGrid1.Cells[4,1]:=IntToStr(59);
form1.StringGrid1.Cells[4,2]:=IntToStr(61);
form1.StringGrid1.Cells[4,3]:=IntToStr(49);
form1.StringGrid1.Cells[4,5]:=IntToStr(42);
form1.StringGrid1.Cells[5,1]:=IntToStr(45);
form1.StringGrid1.Cells[5,2]:=IntToStr(72);
form1.StringGrid1.Cells[5,3]:=IntToStr(85);
form1.StringGrid1.Cells[5,4]:=IntToStr(42);
form1.StringGrid2.Cells[1,2]:=IntToStr(3);
form1.StringGrid2.Cells[1,3]:=IntToStr(2);
form1.StringGrid2.Cells[1,4]:=IntToStr(2);
form1.StringGrid2.Cells[1,5]:=IntToStr(2);
form1.StringGrid2.Cells[2,1]:=IntToStr(3);
form1.StringGrid2.Cells[2,3]:=IntToStr(1);
form1.StringGrid2.Cells[2,4]:=IntToStr(1);
form1.StringGrid2.Cells[2,5]:=IntToStr(1);
form1.StringGrid2.Cells[3,1]:=IntToStr(2);
form1.StringGrid2.Cells[3,2]:=IntToStr(1);
form1.StringGrid2.Cells[3,4]:=IntToStr(2);
form1.StringGrid2.Cells[3,5]:=IntToStr(2);
form1.StringGrid2.Cells[4,1]:=IntToStr(2);
form1.StringGrid2.Cells[4,2]:=IntToStr(1);
form1.StringGrid2.Cells[4,3]:=IntToStr(2);
form1.StringGrid2.Cells[4,5]:=IntToStr(1);
form1.StringGrid2.Cells[5,1]:=IntToStr(2);
form1.StringGrid2.Cells[5,2]:=IntToStr(1);
form1.StringGrid2.Cells[5,3]:=IntToStr(2);
form1.StringGrid2.Cells[5,4]:=IntToStr(1);
end;
end.
