 |
Список использованных источников
|
|
|
|
1. Максимей И.В. Имитационное моделирование на ЭВМ. - М.: Радио и связь, 1988. - 232 с.
2. Технология системного моделирования / Под общ. ред. С.В. Емельянова. - М.: Машиностроение; Берлин: Техник, 1988. - 520 с.
3. Задачи и модели ИСО. Ч.3. Технология имитации на ЭВМ и принятие решений: Уч. пособие / И.В. Максимей, В.Д. Левчук, С.П. Жогаль, В.Н. Подобедов. - Гомель: БелГУТ, 1999. - 150 с.
4. Левчук В.Д. Базовая схема формализации системы моделирования MICIC4 // Проблемы программирования. - 2005. - № 1. - С.85-96.
Приложение
Листинг программы
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls, jpeg;
type
TForm1 = class (TForm)
GroupBox1: TGroupBox;
Panel1: TPanel;
Panel2: TPanel;
VertexPrompt: TLabel;
VertexCount: TEdit;
Button1: TButton;
Button2: TButton;
Capofedge: TStringGrid;
GroupBox3: TGroupBox;
StringGrid1: TStringGrid;
GroupBox4: TGroupBox;
StringGrid2: TStringGrid;
Edit1: TEdit;
Button3: TButton;
Memo1: TMemo;
Button4: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Label1: TLabel;
StringGrid3: TStringGrid;
GroupBox5: TGroupBox;
Label2: TLabel;
Edit2: TEdit;
StringGrid4: TStringGrid;
StringGrid5: TStringGrid;
Label3: TLabel;
Label4: TLabel;
Edit3: TEdit;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Edit4: TEdit;
Label8: TLabel;
Edit5: TEdit;
Label9: TLabel;
Panel3: TPanel;
Image1: TImage;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Edit6: TEdit;
Label13: TLabel;
Edit7: TEdit;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Button5: TButton;
Label17: TLabel;
procedure Button2Click (Sender: TObject);
procedure Button1Click (Sender: TObject);
procedure VertexCountChange (Sender: TObject);
procedure Button3Click (Sender: TObject);
procedure Button4Click (Sender: TObject);
procedure Edit2Change (Sender: TObject);
procedure Button5Click (Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const
N1=100;
l=MAXINT;
var
Form1: TForm1;
n: integer;
kol2,op,rr,nn,mi,tool,kon: integer;
j1,l6,w, i,z,j,ko,h1,h2,sum,ss,maxpotok,j3,k3,kk,potok,o,ll,kol1,pp,p1,j2,kol,t: integer;
c: array [1. N1,1. N1] of integer;
c1: array [1. N1,1. N1] of real;
c2: array [1. N1,1. N1] of real;
tt: array [1..50,1..50] of real;
fij: array [1..50,1..50] of real;
yij: array [1..50,1..50] of real;
y1i: array [1..50,1..50] of real;
xij: array [1..10,1..50] of real;
fij1: array [1.20,1.20] of real;
|
|
|
ttt: array [1.20,1.20] of real;
dij: array [1.20] of real;
Fi: array [1.20] of real;
lhh: array [1.20,1.20] of real;
hij: array [1.20] of real;
hi: array [1.20] of integer;
potokvr: array [1.20] of integer;
d11,d22,d33,z1,l5,mm,ten,w1,t1,kol3,lop,bpp,loop,ten1,bred1,bred2: real;
lh: array [1. N1,1. N1] of integer;
qh: array [1. N1,1. N1] of integer;
f: array [1. N1,1. N1] of integer;
const
size = N1 + 2;
type
queue = record
a: array [0. size-1] of integer;
head, tail: integer;
end;
var
p: array [1. N1] of integer; // номер предыдущей вершины
v: array [1. N1] of boolean; // посещенность
q: queue;
implementation
{$R *. dfm}
procedure init_queue (var q: queue); // инициализировать очередь
begin
with q do
begin
tail: = 0;
head: = 0;
end;
end;
function is_queue_empty (const q: queue): boolean; // Проверка пустоты
begin
is_queue_empty: = q. tail = q. head;
end;
procedure push (var q: queue; x: integer); // Положить элемент в очередь
begin
with q do
begin
a [tail]: = x;
tail: = (tail + 1) mod size;
end;
end;
function pop (var q: queue): integer; // Достать из очереди
begin
with q do
begin
pop: = a [head];
head: = (head + 1) mod size;
end;
end;
// Метод Форда-Фалкерсона
function mff (xo, xn: integer): boolean;
var
i, j: integer;
begin
fillchar (v, sizeof (v), false); { обнуляем массив посещений }
init_queue (q); { инициализируем очередь }
push (q, xo); { заталкиваем в очередь исток }
v [xo]: = true; { посетили исток }
p [xo]: = - 1; { у истока нет предка }
while not is_queue_empty (q) do { пока очередь не пуста }
begin
i: = pop (q); { достаем вершину из очереди }
for j: = 1 to n do { перебираем все вершины }
if not v [j] and { вершина не посещена }
(c [i, j] -f [i, j] > 0) then { ребро i->j ненасыщенное }
begin
v [j]: = true; { посетили вершину j }
push (q, j); { положили веришину j в очередь }
p [j]: = i; { i предок j }
end;
end;
mff: = v [xn]; { дошли ли до стока }
end;
{ min: минимум из двух вещественных чисел }
function min (a, b: integer): integer;
begin
if a > b then min: = b else min: = a;
end;
// максимальное значение потока }
procedure maxpotok1 (xo, xn: integer);
var
k: integer;
d,d1,potok: integer;
begin
kk: =0;
repeat
begin
if c [1,j3] <>0 then
begin
kk: =kk+1;
j3: =j3+1;
end
else j3: =j3+1;
end;
until j3>n;
fillchar (f, sizeof (f), 0); // обнуляем gjnjr
potok: = 0;
while mff (xo, xn) do // Пока существует путь от xo в xn}
begin
d: = l;
d1: = l; // ребро в этом пути с минимальной
k: = xn; // пропускной способностью
while k <> xo do
begin
d: = min (d,c [p [k], k] -f [p [k], k]);
d1: = min (d1,c [p [k], k] -f [p [k], k]);
k: = p [k];
|
|
|
end;
k: = xn; // идем по найденому пути от xo к xn
while k <> xo do
begin
f [p [k], k]: = f [p [k], k] + d; // увеличиваем по прямым ребрам
f [k, p [k]]: = f [k, p [k]] - d; // уменьшаем по обратным ребрам
k: = p [k];
end;
j3: =1;
potok: = potok + d1;
// увеличиваем поток
if k3<>kk then k3: =k3+1 else
begin
i: =1; j2: =1;
for j1: =1+t to n+t do
begin
for j: =1 to n do
begin
tt [j1,j2]: =f [i,j];
if j2<=n then j2: =j2+1;
if j2>n then j2: =1;
end;
if i<n then i: =i+1; end;
t: =t+n;
potokvr [z]: =potok;
z: =z+1;
// строим lhh
kol2: =0;
for i: =1 to n do
for j: =1 to n do
kol2: =kol2+lh [i,j];
for i: =1 to n do
for j: =1 to n do
lhh [i,j]: =lh [i,j] /kol2;
// построили матрицу lhh
// дополнительная часть программы
{razigrivaem}
p1: =1;
for i: =1 to n do
begin
sum: =0;
ko: =0; t1: =0;
for j: =1 to n do
if f [i,j] >0 then
begin
w1: =Random;
for w: =1 to ll do
begin
if w1<hij [w] +t1 then begin
ss: =f [i,j] *hi [w];
sum: =sum+ss;
ko: =ko+f [i,j];
break;
end
else t1: =hij [w] +t1;
end;
end; if ko=0 then ko: =1;
dij [p1]: =sum/ko; p1: =p1+1;
end;
for i: =1 to n do
for j: =1 to n do
begin
yij [i,j]: =d11*lhh [i,j];
fij1 [i,j]: =0;
end;
{umnozit matr na vek}
i: =0;
while op<=n do
begin
rr: =1;
i: =i+1;
while rr<=n do
begin
mm: =0;
for j: =1 to n do mm: =mm+qh [i,j] *lh [j,rr];
ttt [op,rr]: =mm; rr: =rr+1;
end;
op: =op+1;
end;
lop: =0;
for i: =1 to n do
for j: =1 to n do
lop: =lop+ttt [i,j];
for i: =1 to n do
for j: =1 to n do
ttt [i,j]: =d33* (ttt [i,j] /lop);
for i: =1 to n do
for j: =1 to n do
if f [i,j] >0 then begin
fij1 [i,j]: =lh [i,j] /f [i,j] +dij [i];
kol3: =kol3+fij1 [i,j];
end;
for i: =1 to n do
for j: =1 to n do
begin
fij1 [i,j]: = (fij1 [i,j] /kol3) *d22;
end;
{vischitivaem vse fij*}
for i: =1 to n do
for j: =1 to n do
begin
fij [i,j]: =ttt [i,j] +fij1 [i,j] +yij [i,j];
end;
{nahodim F=sumfij*}
lop: =0;
for i: =1 to n do
for j: =1 to n do
lop: =lop+fij [i,j];
Fi [mi]: =lop;
mi: =mi+1;
// конец дополнительной части
end; end;
maxpotok: =potok; // возвращаем максимальный поток
end;
procedure TForm1. Button2Click (Sender: TObject);
begin
Form1. Close;
end;
procedure TForm1. Button1Click (Sender: TObject);
var i,j,fcost: integer;
begin
Label10. Visible: =false;
Label11. Visible: =true;
Label12. Visible: =true;
Edit6. Visible: =true;
Label13. Visible: =true; Label14. Visible: =false;
Label15. Visible: =true;
Label17. Visible: =true; Button5. Visible: =true;
Edit7. Visible: =true;
Panel3. Visible: =true;
Image1. Visible: =true;
d11: =strtofloat (Edit3. text);
d22: =strtofloat (Edit4. text);
d33: =strtofloat (Edit5. text);
GroupBox3. Visible: =false;
Label1. Visible: =true;
Edit1. Visible: =true;
n: =strtoint (VertexCount. text);
ll: =strtoint (Edit2. text);
for i: =1 to n do
for j: =1 to n do begin
c [j, i]: =StrToInt (CapOfEdge. Cells [i,j]);
end;
for i: =1 to n do
for j: =1 to n do begin
qh [j, i]: =StrToInt (StringGrid3. Cells [i,j]);
end;
for i: =1 to n do
for j: =1 to n do begin
lh [j, i]: =StrToInt (StringGrid1. Cells [i,j]);
end;
for i: =1 to ll do
hij [i]: =StrToFloat (StringGrid4. Cells [i-1,0]);
for i: =1 to ll do
hi [i]: =StrToInt (StringGrid5. Cells [i-1,0]);
maxpotok1 (1,n);
// ср. поток
for i: =1 to mi-1 do
ten: =ten+potokvr [i];
ten1: =trunc (ten/ (mi-1));
// ср. выгода
for i: =1 to mi-1 do
loop: =loop+Fi [i];
loop: =loop/ (mi-1);
// матрица всех потоков
j1: =0; j2: =0;
for i: =1 to t do
begin
|
|
|
j: =1; j2: =j2+1; j3: =1;
while j<=n do
begin
bpp: =0;
for h1: =0 to mi do
bpp: =bpp+tt [i+n*h1,j];
yij [j2,j3]: =bpp/ (mi-1);
j3: =j3+1; j: =j+1;
end; end;
// усредненная матрица всех потоков
for i: =1 to n do
for j: =1 to n do
begin
y1i [i,j]: =round (yij [i,j]);
end;
i: =1; bred1: =0;
begin
for j: =1 to n do
bred1: =bred1+y1i [i,j];
if bred1>ten1 then begin
j: =1;
while j<=n do
begin
if (yij [i,j] -trunc (yij [i,j]) >=0.5) and (yij [i,j] -trunc (yij [i,j]) <1)
then begin y1i [i,j]: =y1i [i,j] -1; break; end
else j: =j+1; end;
end;
if bred1<ten1 then begin j: =1;
while j<=n do
begin
if (yij [i,j] -trunc (yij [i,j]) >=0.5) and (yij [i,j] -trunc (yij [i,j]) <1)
then begin y1i [i,j]: =y1i [i,j] +1; break; end
else j: =j+1
end; end;
for j: =1 to n do
y1i [j, i]: =-1*y1i [i,j];
end;
i: =n; bred1: =0;
begin
for j: =1 to n do
bred1: =bred1+y1i [i,j];
bred1: =-1*bred1;
if bred1>ten1 then begin
j: =1;
while j<=n do
begin
if (yij [i,j] -trunc (yij [i,j]) >=0.5) and (yij [i,j] -trunc (yij [i,j]) <1)
then begin y1i [i,j]: =y1i [i,j] +1; break; end
else j: =j+1;
end; end;
if bred1<ten1 then begin j: =1;
while j<=n do
begin
if (yij [i,j] -trunc (yij [i,j]) >=0.5) and (yij [i,j] -trunc (yij [i,j]) <1)
then begin y1i [i,j]: =y1i [i,j] -1; break; end
else j: =j+1
end; end;
for j: =1 to n do
y1i [j, i]: =-1*y1i [i,j];
end;
kon: =0;
while kon<=n-1 do
begin
bred2: =0;
i: =2+kon;
for j: =1 to n do
bred2: =bred2+y1i [i,j];
begin
if bred2>0 then begin j: =2+kon;
while j<=n-1 do
begin
if (yij [i,j] -trunc (yij [i,j]) >=0.5) and (yij [i,j] -trunc (yij [i,j]) <1)
then begin y1i [i,j]: =y1i [i,j] -1; break; end
else j: =j+1
end; end;
if bred2<0 then begin j: =2+kon;
while j<=n-1 do
begin
if (yij [i,j] -trunc (yij [i,j]) >=0.5) and (yij [i,j] -trunc (yij [i,j]) <1)
then begin y1i [i,j]: =y1i [i,j] +1; break; end
else j: =j+1
end; end;
for j: =2+kon to n-1 do
y1i [j, i]: =-1*y1i [i,j];
end;
kon: =kon+1;
end;
// поиск узких мест в сети дорог
for i: =1 to n do
for j: =1 to n do
c1 [i,j]: =y1i [i,j] -c [i,j];
for i: =1 to n do
for j: =1 to n do
CapOfEdge. Cells [j, i]: =floattostr (y1i [i,j]);
for i: =1 to n do
for j: =1 to n do
StringGrid3. Cells [j, i]: =Floattostr (c1 [i,j]);
edit1. text: =floattostr (loop);
edit6. text: =floattostr (ten1);
edit7. text: =floattostr (maxpotok);
loop: =0; ten1: =0;
end;
procedure TForm1. VertexCountChange (Sender: TObject);
var i,j: integer;
begin
z: =1; mi: =1;
t: =0; ss: =0;
kk: =0; k3: =1;
kol: =0; kol1: =0;
ko: =0; sum: =0;
l5: =0; l5: =0;
pp: =1; o: =1;
op: =1;
// hij [1]: =0.2; hij [2]: =0.3; hij [3]: =0.5; d33: =0.25;
// hi [1]: =4; hi [2]: =5; hi [3]: =3; d11: =0.25; d22: =0.5;
l6: =0;
if VertexCount. Text<>'' then begin
CapOfEdge. ColCount: =StrToInt (VertexCount. Text) +1;
CapOfEdge. RowCount: =StrToInt (VertexCount. Text) +1;
StringGrid3. ColCount: =StrToInt (VertexCount. Text) +1;
StringGrid3. RowCount: =StrToInt (VertexCount. Text) +1;
StringGrid1. ColCount: =StrToInt (VertexCount. Text) +1;
StringGrid1. RowCount: =StrToInt (VertexCount. Text) +1;
n: =StrToInt (VertexCount. Text);
for i: =1 to n do begin
CapOfEdge. Cells [0, i]: ='x'+IntToStr (i);
CapOfEdge. Cells [i,0]: ='x'+IntToStr (i);
end;
for i: =1 to n do
for j: =1 to n do begin
CapOfEdge. Cells [i,j]: ='0';
end;
for i: =1 to n do begin
|
|
|
StringGrid3. Cells [0, i]: ='x'+IntToStr (i);
StringGrid3. Cells [i,0]: ='x'+IntToStr (i);
end;
for i: =1 to n do
for j: =1 to n do begin
StringGrid3. Cells [i,j]: ='0';
end;
for i: =1 to n do begin
StringGrid1. Cells [0, i]: ='x'+IntToStr (i);
StringGrid1. Cells [i,0]: ='x'+IntToStr (i);
end;
for i: =1 to n do
for j: =1 to n do begin
StringGrid1. Cells [i,j]: ='0';
end;
end;
end;
procedure TForm1. Button3Click (Sender: TObject);
var f: textfile; i,j,n: integer; s: string;
Begin
opendialog1. filter: ='текстовые файлы|*. txt|';
if opendialog1. execute and fileexists (opendialog1. filename)
then begin
assignfile (f,opendialog1. filename);
reset (f);
readln (f,n);
for i: =1 to n do
for j: =1 to n do begin readln (f,s);
stringgrid3. cells [j-1, i-1]: =s;
end;
for i: =1 to n do
for j: =1 to n do begin readln (f,s);
stringgrid1. cells [j-1, i-1]: =s;
end;
for i: =1 to n do
for j: =1 to n do begin readln (f,s);
Capofedge. cells [j-1, i-1]: =s;
end;
for i: =1 to n do begin readln (f,s);
stringgrid4. cells [i-1,0]: =s;
end;
for i: =1 to n do begin readln (f,s);
stringgrid5. cells [i-1,0]: =s;
end;
readln (f,s); edit3. Text: =s;
readln (f,s); edit4. Text: =s;
readln (f,s); edit5. Text: =s;
closefile (f);
end;
end;
procedure TForm1. Button4Click (Sender: TObject);
var f: textfile; i,j,n: integer;
Begin
savedialog1. filter: ='текстовые файлы|*. txt|';
n: =strtoint (VertexCount. text) +1;
ll: =strtoint (Edit2. text);
if savedialog1. execute then begin
assignfile (f,savedialog1. filename);
rewrite (f);
writeln (f,n);
for i: =1 to n do
for j: =1 to n do
writeln (f,stringgrid3. cells [j-1, i-1]);
for i: =1 to n do
for j: =1 to n do
writeln (f,stringgrid1. cells [j-1, i-1]);
for i: =1 to n do
for j: =1 to n do
writeln (f,Capofedge. cells [j-1, i-1]);
for i: =1 to n do
writeln (f,stringgrid4. cells [i-1,0]);
for i: =1 to n do
writeln (f,stringgrid5. cells [i-1,0]);
writeln (f,edit3. text);
writeln (f,edit4. text);
writeln (f,edit5. text);
closefile (f);
end;
end;
procedure TForm1. Edit2Change (Sender: TObject);
begin
ll: =StrToInt (Edit2. Text);
StringGrid4. ColCount: =StrToInt (Edit2. Text);
StringGrid5. ColCount: =StrToInt (Edit2. Text);
end;
procedure TForm1. Button5Click (Sender: TObject);
begin
StringGrid3. Visible: =false;
Label11. Visible: =false;
GroupBox4. Visible: =false;
for i: =1 to n do
for j: =1 to n do
if c1 [i,j] <0 then c2 [i,j]: =c [i,j] + (-1) *c1 [i,j];
for i: =1 to n do
for j: =1 to n do
CapOfEdge. Cells [j, i]: =floattostr (c2 [i,j]);
for i: =1 to n do
for j: =1 to n do
end;
|
|
|
