|
Реферат: Расчет сетевой модели методом Форда (с программой) (Компьютеры)
{ Программа: Метод Форда }
{ Автор: }
{ Версия: v1.0 }
PROGRAM ford;
uses crt,graph;
const menu:array[0..4,1..6] of string =
(('Ввод данных','Решение задачи','Вывод результата',
'О методе','О программе','Выход'),
('Ввод данных','Просмотр данных','Назад','','',''),
('Экран','Файл','Назад','','',''),
('Клавиатура','Файл','Назад','','',''),
('Да','Нет','','','',''));
menuof:array[0..4] of byte =(6,3,3,3,2);
menugo:array[0..4,1..6] of byte = ((1,0,2,0,0,4), (3,0,0,0,0,0),
(0,0,0,0,0,0), (0,0,1,0,0,0), (0,0,0,0,0,0));
name1='input.dat';
name2='output.dat';
xxx=140;
yyy=20;
xx1=10;
yy1=140;
messize=3;
col:array[16..31] of
byte=(0,186,113,4,40,41,41,42,42,43,44,69,15,15,15,15);
title:array[0..messize] of string = ('АЛГОРИТМИЧЕСКИЕ МЕТОДЫ',
' ИССЛЕДОВАНИЯ ОПЕРАЦИЙ ', ' ', ' Метод Форда
');
type matr = array[0..20,0..20] of real;
coord = array [1..20,1..2] of real;
var mas:matr;
coord_point:coord;
i,j,t,m,n,z,x1,y1,x2,kk,iii,y2,x,y,lenth,chrus,z1,z2:integer;
k:array[1..20] of real;
result:array[1..20] of integer;
error_code:array[1..5] of byte;
fire1:array[1..yyy,1..xxx] of byte;
fire2:array[1..yyy,1..xxx] of byte;
mask:array[1..6] of byte;
starx:array[1..500] of word;
stary:array[1..500] of word;
starc:array[1..500] of byte;
aa,cc,pi1,s:real;
l,inputdata,calculatedata,move:boolean;
o:string;
temp,cursor,lastcursor,menulevel,nline,step:byte;
pressed:char;
f1,f2:text;
FUNCTION min:real;
begin
s:=0;
for i:=1 to n do
if (s=0) and (k[i]-1) then s:=k[i]
else if(k[i]9 then outtextxy(round(coord_point[i,1]-12),
round(coord_point[i,2]-12),o)
else outtextxy(round(coord_point[i,1]-7),
round(coord_point[i,2]-12),o);
end;
repeat until keypressed;
end;
PROCEDURE draw_ways;
begin
settextstyle(chrus,0,2);
for i:=1 to n do
for j:=1 to n do
if mas[i,j]-1 then
begin
x1:=round(coord_point[i,1]);
y1:=round(coord_point[i,2]);
x2:=round(coord_point[j,1]);
y2:=round(coord_point[j,2]);
setcolor(15);
line(x1,y1,x2,y2);
temp:=round(mas[i,j]);
str(temp,o);
setcolor(2);
outtextxy(round((x1+x2)/2+5),round((y1+y2)/2+5),o);
end;
end;
PROCEDURE draw_short_way;
begin
for i:=1 to lenth-1 do
begin
setlinestyle(0,0,3);
setcolor(red);
x:=result[i];
y:=result[i+1];
x1:=round(coord_point[x,1]);
y1:=round(coord_point[x,2]);
x2:=round(coord_point[y,1]);
y2:=round(coord_point[y,2]);
line(x1,y1,x2,y2);
end;
settextstyle(chrus,0,1);
setcolor(14);
outtextxy(50,370,'Кратчайший маршрут: ');
for i:=1 to lenth do
begin
str(result[lenth-i+1],o);
outtextxy(300+i*15,370,o);
end;
outtextxy(50,400,'Длинна кратчайшего маршрута: ');
str(round(mas[0,n]),o);
outtextxy(420,400,o);
end;
PROCEDURE count_point_coord;
begin
pi1:=(2*pi)/n;
m:=0;
aa:=3*pi/2;
for i:=1 to n do
begin
coord_point[i,1]:=(cos(aa)*150)+300;
coord_point[i,2]:=(sin(aa)*150)+200;
aa:=aa+pi1;
end;
end;
PROCEDURE set_font;
begin
chrus:=installuserfont('fn03');
settextstyle(chrus,0,2);
end;
PROCEDURE calculate;
begin
for i:=1 to n do
k[i]:=0;
clrscr;
mas[0,1]:=0;
mas[1,0]:=0;
{3}
for j:=2 to n do
begin
for i:=1 to n do
if (mas[0,i]-1) and (mas[i,j]-1)
then k[i]:=mas[0,i]+mas[i,j]
else k[i]:=-1;
mas[0,j]:=min;
mas[j,0]:=mas[0,j];
end;
{4}
repeat
l:=true;
for i:=1 to n do
for j:=1 to n do
if (mas[0,j]-mas[0,i]>mas[i,j]) and (mas[i,j]-1) then
begin
l:=false;
mas[0,j]:=mas[0,i]+mas[i,j];
end;
until l;
{5}
j:=n;
m:=1;
t:=0;
for i:=1 to n do
result[i]:=-1;
result[1]:=n;
repeat
inc(m);
for i:=1 to j do
begin
if (mas[i,j]-1) and (ij) and (mas[i,j]=mas[0,j]-mas[0,i])
then
begin
t:=i;
break;
end;
end;
result[m]:=t;
j:=t;
lenth:=m;
until j=1;
calculatedata:=true;
ok;
end;
PROCEDURE stars;
begin
for i:=1 to 500 do
begin
starx[i]:=round(random(640));
stary[i]:=round(random(480));
starc[i]:=round(31-random(16));
end;
end;
PROCEDURE draw_menu;
begin
cleardevice;
for i:=1 to 500 do
putpixel(starx[i],stary[i],starc[i]);
cursor:=1;
lastcursor:=cursor;
for i:=1 to 260 do
begin
setcolor(8);
line(210+i,110,210+i,110);
setcolor(4);
line(200+i,100,200+i,100);
end;
for j:=1 to nline*30+10 do
begin
setcolor(8);
line(210,110+j,470,110+j);
setcolor(4);
line(200,100+j,460,100+j);
end;
setcolor(0);
for j:=1 to nline do
outtextxy(220,110+(j-1)*25,menu[menulevel,j]);
end;
PROCEDURE redraw_menu;
begin
for j:=nline*30+10 downto 1 do
begin
setcolor(0);
line(210,110+j,470,110+j);
line(200,100+j,210,100+j);
setcolor(8);
if j | |
