Каталог Рефератов - Разработка имитационной модели транспортной сети

	Информационно-образоательный портал
	Рефераты, курсовые, дипломы, научные работы,



МЕНЮ\|

поиск

Разработка имитационной модели транспортной сети

ij: 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;

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;

function pop (var q: queue): integer; // Достать из очереди

begin

with q do

begin

pop: = a [head] ;

head: = (head + 1) mod size;

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;

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;

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;

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;

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;

Страницы: 1, 2, 3

© 2003-2013
Рефераты бесплатно, курсовые, рефераты биология, большая бибилиотека рефератов, дипломы, научные работы, рефераты право, рефераты, рефераты скачать, рефераты литература, курсовые работы, реферат, доклады, рефераты медицина, рефераты на тему, сочинения, реферат бесплатно, рефераты авиация, рефераты психология, рефераты математика, рефераты кулинария, рефераты логистика, рефераты анатомия, рефераты маркетинг, рефераты релиния, рефераты социология, рефераты менеджемент.