реферат, рефераты скачать Информационно-образоательный портал
Рефераты, курсовые, дипломы, научные работы,
реферат, рефераты скачать
реферат, рефераты скачать
МЕНЮ|
реферат, рефераты скачать
поиск
Расчет сетевой модели методом Форда (с программой)

Расчет сетевой модели методом Форда (с программой)

{ Программа: Метод Форда }

{ Автор: }

{ Версия: 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]-1)

then s:=k[i];

min:=s;

end;

PROCEDURE set_graph_mode;

begin

z1:=installuserdriver('svga256',nil);

initgraph(z1,z2,'');

cleardevice;

end;

PROCEDURE pixel(x:word;y,col:byte);

begin

asm

mov bx,x

mov cl,y

mov dl,col

mov ax,0a000h

mov es,ax

mov al,0a0h

mul cl

add ax,ax

add bx,ax

mov [es:bx],dl

end;

end;

PROCEDURE install_firewall;

begin

for i:=1 to yyy do

for j:=1 to xxx do

begin

fire1[i,j]:=0;

fire2[i,j]:=0;

end;

end;

PROCEDURE fire;

begin

for i:=1 to yyy-1 do

for j:=1 to xxx do

begin

pixel(j*2+xx1,i*3+yy1,col[fire1[i,j]]);

pixel(j*2+xx1,i*3+yy1-1,col[fire1[i,j]]);

pixel(j*2+xx1,i*3+yy1-2,col[fire1[i,j]]);

end;

for j:=1 to xxx do

begin

kk:=random(8);

if kk31) then fire2[i,j]:=16;

end;

for i:=1 to yyy do

for j:=1 to xxx do

fire1[i,j]:=fire2[i,j];

end;

PROCEDURE ok;

begin

cleardevice;

setcolor(1);

rectangle(120,100,520,220);

rectangle(100,120,540,200);

setcolor(14);

outtextxy(180,130,'Опeрация произведена');

outtextxy(250,160,'корректно.');

repeat until keypressed;

end;

PROCEDURE notok;

begin

cleardevice;

setcolor(4);

rectangle(120,100,520,220);

rectangle(100,120,540,200);

setcolor(14);

outtextxy(180,130,'Опeрация произведена');

outtextxy(230,160,'не корректно.');

repeat until keypressed;

end;

PROCEDURE check_input_data;

begin

inputdata:=true;

for i:=1 to 5 do

error_code[i]:=0;

for i:=0 to n do

begin

if mas[i,1]<>-1 then error_code[1]:=1;

if mas[n,i]<>-1 then error_code[2]:=1;

if mas[i,i]<>-1 then error_code[3]:=1;

end;

for i:=1 to n do

for j:=1 to n do

begin

if (mas[i,j]<>-1) and (mas[j,i]<>-1) then error_code[4]:=1;

if (mas[i,j]-1) then error_code[5]:=1;

end;

clrscr;

if error_code[1]<>0 then

writeln('Ошибка: Не существует истока.');

if error_code[2]<>0 then

writeln('Ошибка: Не существует стока.');

if error_code[3]<>0 then

writeln('Ошибка: Существует дуга из одной вершины в ту же вершину.');

if error_code[4]<>0 then

writeln('Ошибка: Существует две дуги из одной вершины в другую.');

if error_code[5]<>0 then

writeln('Ошибка: Существует дуга с отрицительной нагрузкой.');

for i:=1 to 5 do

if error_code[i]<>0 then inputdata:=false;

if (z<>0) or (round(n)<>n) or (n20) then inputdata:=false;

calculatedata:=false;

end;

PROCEDURE keyboard_input;

begin

z:=0;

closegraph;

clrscr;

write('Введите колличество пунктов(2-20): ');

readln(o);

val(o,n,z);

if (z<>0) or (round(n)<>n) or (n20) then check_input_data;

writeln(' Введите нагрузку. Если дуга не существует, то нажмите

Enter.');

writeln;

for i:=1 to n-1 do

for j:=i to n do

if i<>j then

begin

write(' Введите нагрузку от ',i,'-й вершины до ',j,'-й

вершины:');

readln(o);

if o<>'' then val(o,mas[i,j],z)

else mas[i,j]:=-1;

if z<>0 then exit;

end;

check_input_data;

set_graph_mode;

settextstyle(chrus,0,2);

if inputdata=true then ok

else notok;

end;

PROCEDURE ramka;

begin

cleardevice;

setcolor(1);

rectangle(30,10,610,470);

rectangle(10,30,630,450);

end;

PROCEDURE save;

begin

assign(f2,name2);

rewrite(f2);

write(f2,'Кратчайший маршрут: ');

for i:=1 to lenth do

write(f2,result[lenth-i+1]);

writeln(f2,'');

write(f2,'Длинна кратчайшего маршрута: ');

write(f2,round(mas[0,n]));

close(f2);

ok;

end;

PROCEDURE about_program;

begin

ramka;

settextstyle(chrus,0,5);

setcolor(14);

outtextxy(160,30,'О программе');

settextstyle(chrus,0,1);

setcolor(12);

outtextxy(40,100,'Программа: ');

outtextxy(40,150,'Версия: ');

outtextxy(40,175,'Назначение: ');

outtextxy(40,240,'Автор: ');

outtextxy(40,265,'Дата: ');

setcolor(8);

outtextxy(200,100,'Решение задачи о кратчайшем');

outtextxy(200,120,'маршруте методом Форда.');

outtextxy(200,150,'v1.0');

outtextxy(200,175,'Курсовой проект по дисциплине');

outtextxy(200,195,'"Алгоритмические методы иссле-');

outtextxy(200,215,'дования опираций"');

outtextxy(200,240,’’);

outtextxy(200,265,'декабрь 1998 года');

setcolor(11);

outtextxy(50,395,'для большей информации смотрите README.TXT');

repeat until keypressed;

end;

PROCEDURE about_metod;

begin

ramka;

settextstyle(chrus,0,5);

setcolor(14);

outtextxy(130,30,'О методе Форда');

settextstyle(chrus,0,1);

setcolor(8);

outtextxy(40,90,'Метод Форда был разработан специально для');

outtextxy(50,110,'решения сетевых транспортных задач и осно-');

outtextxy(50,130,'ван, по существу на принципе оптимальности.');

outtextxy(40,150,'Алгоритм метода Форда содержит четыре этапа.');

outtextxy(50,170,'На первом этапе производится заполнение ис-');

outtextxy(50,190,'ходной таблицы расстояний от любого i-го');

outtextxy(50,210,'пункта в любой другой j-й пункт назначения');

outtextxy(50,230,'На втором этапе определяются для каждого');

outtextxy(50,250,'пункта некоторые параметры Ai и Aj по соот-');

outtextxy(50,270,'ветствующим формулам и правилам. Далее на');

outtextxy(50,290,'третьем этапе определяется кратчайшее рас-');

outtextxy(50,310,'стояние. Наконец, на четвертом этапе опре-');

outtextxy(50,330,'деляются кратчайшие маршруты из пункта');

outtextxy(50,350,'отправления Р1 в любой пункт назначения Рj,');

outtextxy(50,370,'j=2,3,...,n.');

repeat until keypressed;

end;

PROCEDURE output_graph;

begin

settextstyle(chrus,0,1);

for i:=1 to n do

begin

setcolor(10);

fillellipse(round(coord_point[i,1]),round(coord_point[i,2]),15,15);

setcolor(15);

str(i,o);

if 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 (i<>j) 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 j1) and not(move) then

begin

lastcursor:=cursor;

dec(cursor);

end;

end;

until pressed=#13;

redraw_menu;

if cursor=5 then about_program;

if cursor=4 then about_metod;

if (cursor=1) and (menulevel=3) then keyboard_input;

if (cursor=1) and (menulevel=4) then

begin

closegraph;

halt;

end;

if (cursor=2) and (menulevel=1) and (inputdata=false) then notok;

if (cursor=2) and (menulevel=1) and (inputdata=true) then

begin

count_point_coord;

draw_ways;

output_graph;

end;

if (cursor=2) and (menulevel=0) and (inputdata=true) then calculate;

if (cursor=2) and (menulevel=0) and (inputdata=false) then notok;

if (cursor=1) and (menulevel=2) and (calculatedata=false) then notok;

if (cursor=1) and (menulevel=2) and (calculatedata=true) then

begin

count_point_coord;

draw_ways;

draw_short_way;

output_graph;

end;

if (cursor=2) and (menulevel=2) and (calculatedata=true) then save;

if (cursor=2) and (menulevel=2) and (calculatedata=false) then notok;

if (cursor=2) and (menulevel=3) then notok;

menulevel:=menugo[menulevel,cursor];

nline:=menuof[menulevel];

main_menu;

end;

PROCEDURE welcomescreen;

begin

settextstyle(chrus,0,1);

randomize;

install_firewall;

for i:=0 to messize do

begin

setcolor(4);

outtextxy(10,iii*step+i*30,title[i]);

end;

repeat

fire;

until keypressed;

end;

BEGIN

for i:=0 to 20 do

for j:=0 to 20 do

mas[i,j]:=-1;

stars;

inputdata:=false;

calculatedata:=false;

menulevel:=0;

nline:=menuof[menulevel];

z2:=0;

set_graph_mode;

set_font;

welcomescreen;

closegraph;

z2:=2;

set_graph_mode;

main_menu;

repeat until keypressed;

END.



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