кратчайшие пути из одной заданной вершины графа в другую

Uses Graph;
Const inf=10000;
Type Adjacency_Matrix=record
Connection:integer;
end;
 
Line_Graph=record
info:integer;
Coord_Circle_X:integer;
Coord_Circle_Y:integer;
Coord_Line_X:integer;
Coord_Line_Y:integer;
Arrows_A:integer;
Arrows_B:integer;
Arrows_C:integer;
Min:integer;
end;
 
Matrix=array [1..100,1..100] of adjacency_Matrix;
Line=array [1..100] of Line_Graph;
Vi=array [1..100] of boolean;
Di=array [1..100] of integer;
 
 
Procedure Init_ (var A:matrix; var B:line; var n:integer; var TFile:Text);
var i,j:integer;
st:char;
begin
randomize;
writeln ('Введите количество вершин графа');
readln (n);
Writeln ('Введите данные о вершинах');
writeln ('Для ориентированного графа');
writeln ('Cгенерировать автоматически ? (Y/N) ');
readln (st);
if (st='Y') or (st='y') then  {Нажатие любой клавиши кроме Enter:
st:=readkey;
if st<>#13 then }
begin
writeln ('Генерация информационной части');
writeln ('Введите информационную часть: ');
for i:=1 to n do
b[i].info:=i;
Writeln ('Генерация матрицы смежности');
for i:=1 to n do
for j:=1 to n do
A[i,j].Connection:=random(2);
end
else
begin
writeln ('Введите информационную часть: ');
for i:=1 to n do
readln (b[i].info);
writeln ('Введите матрицу смежности');
for i:=1 to n do
for j:=1 to n do
read (TFile,a[i,j].Connection);
end;
end;
 
Procedure Graph_Print_ (A:matrix; var B:line; n:integer; X,Y,color:integer);
var k,kol,i,j,x1,y1,x2,y2:integer;
l,si,co:real;
s:string;
begin
for i:=1 to n do
begin
b[i].Coord_Circle_X:=x+round(300*sin(2*pi*i/n));
b[i].Coord_Circle_Y:=y-round(300*cos(2*pi*i/n));
b[i].Coord_line_X:=x+round(275*sin(2*pi*i/n));
b[i].Coord_line_Y:=y-round(275*cos(2*pi*i/n));
{setcolor (random(200));}
setcolor(4);
Circle (B[i].Coord_Circle_X,B[i].Coord_Circle_Y,25);
setfillstyle (1,15);
FloodFill (B[i].Coord_Circle_X,B[i].Coord_Circle_Y,4);
str (B[i].info,s);
setcolor (4);
OuttextXY (B[i].Coord_Circle_X-3,B[i].Coord_Circle_Y-3,s);
setcolor (15);
end;
 
 
for i:=1 to n do
begin
for j:=1 to n do
begin
if (A[i,j].connection=1) and (A[j,i].Connection=1) then
begin
moveto (b[i].Coord_line_X,b[i].Coord_line_Y);
lineto (b[j].Coord_Line_X,b[j].Coord_Line_Y);
end;
 
if (A[i,j].Connection=1) and (A[j,i].Connection=0) then
begin
setcolor(color);
moveto (b[i].Coord_line_X,b[i].Coord_line_Y);
lineto (b[j].Coord_Line_X,b[j].Coord_Line_Y);
L:=sqrt(sqr(b[i].Coord_Line_X-b[j].Coord_Line_X)+sqr(b[i].Coord_Line_Y-b[j].Coord_Line_Y));
si:=(b[j].Coord_Line_X-b[i].Coord_Line_X)/l;
co:=(b[j].Coord_Line_Y-b[i].Coord_Line_Y)/l;
B[i].Arrows_A:=b[j].Coord_Line_X-round (30*si);
B[i].Arrows_B:=b[j].Coord_Line_Y-round (30*co);
setcolor (2);
Circle (B[i].Arrows_A,b[i].Arrows_B,4);
setfillstyle (1,2);
FloodFill (B[i].Arrows_A,b[i].Arrows_B,2);
setcolor (color);
end;
 
if (A[j,i].Connection=1) and (A[i,j].Connection=0) then
begin
setcolor(color);
moveto (b[i].Coord_line_X,b[i].Coord_line_Y);
lineto (b[j].Coord_Line_X,b[j].Coord_Line_Y);
L:=sqrt(sqr(b[j].Coord_Line_X-b[i].Coord_Line_X)+sqr(b[j].Coord_Line_Y-b[i].Coord_Line_Y));
si:=(b[i].Coord_Line_X-b[j].Coord_Line_X)/l;
co:=(b[i].Coord_Line_Y-b[j].Coord_Line_Y)/l;
B[j].Arrows_A:=b[i].Coord_Line_X-round (30*si);
B[j].Arrows_B:=b[i].Coord_Line_Y-round (30*co);
setcolor (4);
Circle (B[j].Arrows_A,b[j].Arrows_B,4);
setfillstyle (1,4);
FloodFill (B[j].Arrows_A,b[j].Arrows_B,4);
setcolor (color);
end;
end;
end;
end;
 
Procedure Init_Task (var v1,v2:integer);
begin
writeln ('Введите первую вершину');
readln (v1);
writeln ('Введите вторую вершину');
readln (v2);
end;
 
Procedure Init_Visited (var Visited:di;n:integer);
var i:integer;
begin
for i:=1 to n do
if visited[i]<>-2 then
visited[i]:=-1;
end;
 
Procedure Init_Revers (var Visited:di; n:integer);
var i:integer;
begin
for i:=1 to n do
visited[i]:=-1;
end;
 
Procedure BFS (A:matrix;var Visited:di; var dlina:integer;v1,v2,n:integer);
var i,start,end_,kol:integer;
q:Di;
begin
kol:=0;
start:=1;
end_:=1;
q[end_]:=v1;
visited[v1]:=kol;
while start <= end_ do
begin
kol:=kol+1;
for i:=1 to n do
if (A[v1,i].Connection<>0) and (visited[i]=-1) then
begin
inc(end_);
q[end_]:=i;
visited[i]:=kol;
end;
kol:=kol+1;
inc(start);
v1:=q[start];
end;
writeln ('Матрица путей');
for i:=1 to n do
begin
if i=v2 then
dlina:=visited[i];
writeln ('Вершина: ',i, ': ',Visited[i]);
end;
end;
 
Procedure Check_Way (A:Matrix; Var Way_Matrix:Matrix; var Visited:di; var s:integer;dlina,v1,v2,n:integer);
var i,j,temp:integer;
begin
if visited[v2]=1 then
begin
s:=1 ;
Way_Matrix[v1,v2].Connection:=1;
end
else
begin
s:=1;
for i:=1 to n do
if visited[v2]=1 then
break
else
if Visited[i]=1 then
begin
visited[v1]:=-2;
Way_Matrix[v1,i].Connection:=1;
v1:=i;
temp:=i;
Init_visited(Visited,n);
BFS (A,Visited,dlina,v1,v2,n);
s:=s+1;
end;
visited[v2]:=-2;
Way_Matrix[temp,v2].Connection:=1;
writeln ('Вывод длины пути: ', s);
end;
end;
 
{Procedure Inversion (A:Matrix; var Way_Revers:Matrix;var Visited_Revers:Di; var s:integer; dlina, v1,v2,n:integer);
var i,j,temp:integer;
begin
temp:=v1;
v1:=v2;
v2:=temp;
Init_visited (Visited_Revers,n);
writeln ('Вывод массива');
for i:=1 to n do
writeln (visited_revers[i]);
Check_Way (A,Way_Revers,Visited_Revers,s,dlina,v1,v2,n);
end;}
 
Procedure Print_ (A:Matrix;B:line; n:integer);
var i,j:integer;
begin
writeln ('Вывод информационной части');
for i:=1 to n do
writeln (B[i].info);
 
writeln ('Вывод матрицы смежности');
for i:=1 to n do
begin
for j:=1 to n do
write (A[i,j].connection);
writeln;
end;
end;
 
var
A,Way_Matrix,Way_Revers:matrix;
B:line;
n:integer;
d,m:integer;
TFile:Text;
i,nn:integer;
v:integer;
Dis,Temp:Di;
Visited,Visited_Revers:di;
v1,v2:integer;
dlina:integer;
color:integer;
temp1,s:integer;
st:char;
begin
randomize;
d:=detect;
InitGraph(d,m,'');
assign (TFile, 'E:\ORTFile.txt');
reset (TFile);
Init_(A,B,n,TFile);
Graph_Print_ (A,B,n,650,350,15);
Init_Task (v1,v2);
Init_visited (Visited,n);
BFS (A,Visited, dlina,v1,v2,n);
Check_Way (A,Way_Matrix,Visited,s,dlina,v1,v2,n);
Graph_Print_ (Way_Matrix,B,n,650,350,4);
writeln ('Вывод минимальной длины: ', s);
writeln ('Вывод массива посещённых вершин');
writeln ('Найти минимальный путь наоборот ? (Y/N) ');
readln (st);
if (st='Y') or (st='y') then
begin
Init_visited (Visited_Revers,n);
temp1:=v2;
v2:=v1;
v1:=temp1;
BFS (A,Visited_Revers, dlina,v1,v2,n);
Check_Way (A,Way_Revers,Visited_Revers,s,dlina,v1,v2,n);
writeln ('Вывод минимальной длины: ', s);
writeln ('Вывод матрицы пути');
Print_(Way_Revers,B,n);
Graph_Print_ (Way_Revers,B,n,650,350,14)
end;
{Print_(A,B,n)}
readln;
end.