Форум на Исходниках.RU

nell как я вижу по книжке Новикова алгоритм нужно сделать ... 8-)

вот код реализации данного алгоритма в моем исполнении:

Program Algoritm_Floid;

{Программа поиска кратчайшего пути между вершинами и его длины при

помощи алгоритма Флойда}

Uses Crt,Graph,Graphs;

Const

M=19; {Предельное число вершин графа}

R=200; {Радиус окружности на которой лежат вершины (центры окружностей)}

Type

Dmas = Array[1..M,1..M] Of Integer;

Var

N, {Число вершин графа}

I,J,

Nac, {Номер начальной вершины}

Kon: Integer; {Номер конечной вершины}

T, {Матрица, хранящая длины путей}

H, {Матрица, хранящая пути}

C: Dmas; {Матрица, хранящая длины дуг}

{===========================================================================}

{ Процедуры используемые в программе }

{===========================================================================}

Procedure Dlina;

{----------------------------------}

{Процедура задания матрицы длин дуг}

{----------------------------------}

Begin

GotoXY(7,7);

Write('Введите число вершин графа: ');

Readln(N); {Задание значения числа вершин}

If N>M Then Halt; {Если вершин больше чем константа M, то выход из программы}

Clrscr; {Очистка экрана}

If N>5 Then {Автоматическое задание значений длин дуг}

For I:=1 To N Do

For J:=1 To N Do

If I=J Then C[I,J]:=0

Else C[I,J]:=Random(100)+1 {Генерация текущего значения}

Else

Begin {Задание длин дуг вводом с клавиатуры}

For I:=1 To N Do

Begin

Writeln;

For J:=1 To N Do

If I<>J Then

Begin

Write('Введите вес дуги [',I,',',J,']:= ');

Readln(C[I,J]) {Ввод с клавиатуры значения длины дуги}

End

Else If I=J Then C[I,J]:=0;

End

End;

{Вывод полученной матрицы дуг}

Clrscr; {Очистка экрана}

Writeln('Матрица длин дуг');

Writeln;

Write(' ');

TextColor(Green); {Задание цвета текста}

For I:=1 To N Do

Write(' ',Chr(64+I),' ');

Writeln;

For I:=1 To N Do

Begin

TextColor(Green); {Задание цвета текста}

Write(' ',Chr(64+I),' ');

TextColor(White); {Задание цвета текста}

For J:=1 To N Do

Write(C[I,J]:3,' '); {Вывод текущего элемента матрицы}

Writeln

End;

Readln {Задержка экрана}

End;

{---------------------------------------------------------------------}

Procedure Floid;

{-----------------------------------------------}

{Процедура нахождения кратчайших путей и их длин}

{-----------------------------------------------}

Var

I,J,K: Integer;

Begin

For I:=1 To N Do

For J:=1 To N Do

Begin

T[I,J]:=C[I,J]; {Начальная установка длин путей}

If C[I,J]=100 Then

H[I,J]:=0 {Нет дуги из вершины "I" в "J" вершину}

Else

H[I,J]:=J {Есть дуга из вершины "I" в "J" вершину}

End;

For I:=1 To N Do

Begin

For J:=1 To N Do

For K:=1 To N Do

If (I<>J) And (T[J,I]<>100) And (I<>K) And (T[I,K]<>100)

And ((T[J,K]=100) Or (T[J,K]>T[J,I]+T[I,K])) Then

Begin

H[J,K]:=I; {Запоминаем новый путь}

T[J,K]:=T[J,I]+T[I,K] {Запоминаем длину данного нового пути}

End;

For J:=1 To N Do

If T[J,J]<0 Then Break {Нет решения: вершина входит в цикл отрицательной длины}

End;

{Вывод полученной матрицы путей}

Clrscr; {Очистка экрана}

Writeln('Матрица путей');

Writeln;

Write(' ');

TextColor(Green); {Задание цвета текста}

For I:=1 To N Do

Write(' ',Chr(64+I),' ');

Writeln;

For I:=1 To N Do

Begin

TextColor(Green); {Задание цвета текста}

Write(' ',Chr(64+I),' ');

TextColor(White); {Задание цвета текста}

For J:=1 To N Do

Write(H[I,J]:3,' '); {Вывод текущего элемента матрицы}

Writeln

End;

Readln; {Задержка экрана}

{Вывод полученной матрицы длин путей}

Clrscr; {Очистка экрана}

Writeln('Матрица длин путей');

Writeln;

Write(' ');

TextColor(Green); {Задание цвета текста}

For I:=1 To N Do

Write(' ',Chr(64+I),' ');

Writeln;

For I:=1 To N Do

Begin

TextColor(Green); {Задание цвета текста}

Write(' ',Chr(64+I),' ');

TextColor(White); {Задание цвета текста}

For J:=1 To N Do

Write(T[I,J]:3,' '); {Вывод текущего элемента матрицы}

Writeln

End;

Readln; {Задержка экрана}

Clrscr; {Очистка экрана}

GotoXY(10,10);

Write('Введите номер начальной вершины пути: '); Readln(Nac);

GotoXY(10,12);

Write('Введите номер конечной вершины пути: '); Readln(Kon);

Writeln;

Write('Длина пути из вершины ',Chr(64+Nac),' в вершину ',Chr(64+Kon),' равна: ',T[Nac,Kon]);

Readln {Задержка экрана}

End;

{--------------------------------------------------------------------------}

Procedure Koordinata;

{-----------------------------------}

{Процедура вывода найденных значений}

{-----------------------------------}

Var

Q,W: Real;

K: Char;

X1,X2,Y1,Y2,

X: Integer;

Begin

Open_Graph; {Подключение графического режима}

Q:=2*Pi/N; {Установка значения угла между границами сектора}

{Задание координат вершин графа}

For I:=1 To N Do

Begin

W:=I*Q; {Установка текущего угла}

{Установка координат}

X1:=300+Trunc(R*cos(W)); Y1:=235+Trunc(R*sin(W));

X2:=300+Trunc((R+25)*cos(W)); Y2:=235+Trunc((R+25)*sin(W));

{-------------------}

K:=Chr(64+I); {Задание текущего названия вершины}

SetColor(White); {Задание цвета названий вершин}

OutTextXY(X2,Y2,K); {Вывод названия вершины}

SetColor(Green); {Задание цвета вершины}

For J:=1 To 7 Do

Circle(X1,Y1,J) {Вывод концентрических окружностей для задания вершины на экране}

End;

{Вывод кратчайшего пути}

X:=Nac;

W:=Q*Nac; {Установка текущего угла}

{Установка координат}

X1:=300+Trunc(R*cos(W)); Y1:=235+Trunc(R*sin(W));

{-------------------}

SetColor(Red);

PutPixel(X1,Y1,Red);

Repeat

X:=H[X,Kon]; {Переход на следующую вершину в пути}

W:=Q*X; {Установка текущего угла}

{Установка координат}

X2:=300+Trunc(R*cos(W)); Y2:=235+Trunc(R*sin(W));

{-------------------}

Line(X1,Y1,X2,Y2);

X1:=X2;

Y1:=Y2

Until X=Kon;

SetColor(White);

OutTextXY(3,450,'Press any key, please...');

Readln; {Задержка экрана}

Close_Graph; {Отключение графического режима}

Clrscr

End;

{----------------------------------------------------------------------}

{===========================================================================}

Begin

{-----------------------}

{Основной блок программы}

{-----------------------}

ClrScr; {Очистка экрана}

TextBackGround(Black); {Задание цвета фона}

TextColor(White); {Задание цвета текста}

Clrscr;

Dlina; {Задание длин дуг}

Floid; {Поиск кратчайшего пути и его длины}

Koordinata {Вывод найденных значений}

End.

з.ы.: полный пример в архиве, там пара дополнительных модуля для Pascal ....

Program Algoritm_Floid;

{Программа поиска кратчайшего пути между вершинами и его длины при

помощи алгоритма Флойда}

Uses Crt,Graph,Graphs;

Const

M=19; {Предельное число вершин графа}

R=200; {Радиус окружности на которой лежат вершины (центры окружностей)}

Type

Dmas = Array[1..M,1..M] Of Integer;

Var

N, {Число вершин графа}

I,J,

Nac, {Номер начальной вершины}

Kon: Integer; {Номер конечной вершины}

T, {Матрица, хранящая длины путей}

H, {Матрица, хранящая пути}

C: Dmas; {Матрица, хранящая длины дуг}

{===========================================================================}

{ Процедуры используемые в программе }

{===========================================================================}

Procedure Dlina;

{----------------------------------}

{Процедура задания матрицы длин дуг}

{----------------------------------}

Begin

GotoXY(7,7);

Write('Введите число вершин графа: ');

Readln(N); {Задание значения числа вершин}

If N>M Then Halt; {Если вершин больше чем константа M, то выход из программы}

Clrscr; {Очистка экрана}

If N>5 Then {Автоматическое задание значений длин дуг}

For I:=1 To N Do

For J:=1 To N Do

If I=J Then C[I,J]:=0

Else C[I,J]:=Random(100)+1 {Генерация текущего значения}

Else

Begin {Задание длин дуг вводом с клавиатуры}

For I:=1 To N Do

Begin

Writeln;

For J:=1 To N Do

If I<>J Then

Begin

Write('Введите вес дуги [',I,',',J,']:= ');

Readln(C[I,J]) {Ввод с клавиатуры значения длины дуги}

End

Else If I=J Then C[I,J]:=0;

End

End;

{Вывод полученной матрицы дуг}

Clrscr; {Очистка экрана}

Writeln('Матрица длин дуг');

Writeln;

Write(' ');

TextColor(Green); {Задание цвета текста}

For I:=1 To N Do

Write(' ',Chr(64+I),' ');

Writeln;

For I:=1 To N Do

Begin

TextColor(Green); {Задание цвета текста}

Write(' ',Chr(64+I),' ');

TextColor(White); {Задание цвета текста}

For J:=1 To N Do

Write(C[I,J]:3,' '); {Вывод текущего элемента матрицы}

Writeln

End;

Readln {Задержка экрана}

End;

{---------------------------------------------------------------------}

Procedure Floid;

{-----------------------------------------------}

{Процедура нахождения кратчайших путей и их длин}

{-----------------------------------------------}

Var

I,J,K: Integer;

Begin

For I:=1 To N Do

For J:=1 To N Do

Begin

T[I,J]:=C[I,J]; {Начальная установка длин путей}

If C[I,J]=100 Then

H[I,J]:=0 {Нет дуги из вершины "I" в "J" вершину}

Else

H[I,J]:=J {Есть дуга из вершины "I" в "J" вершину}

End;

For I:=1 To N Do

Begin

For J:=1 To N Do

For K:=1 To N Do

If (I<>J) And (T[J,I]<>100) And (I<>K) And (T[I,K]<>100)

And ((T[J,K]=100) Or (T[J,K]>T[J,I]+T[I,K])) Then

Begin

H[J,K]:=I; {Запоминаем новый путь}

T[J,K]:=T[J,I]+T[I,K] {Запоминаем длину данного нового пути}

End;

For J:=1 To N Do

If T[J,J]<0 Then Break {Нет решения: вершина входит в цикл отрицательной длины}

End;

{Вывод полученной матрицы путей}

Clrscr; {Очистка экрана}

Writeln('Матрица путей');

Writeln;

Write(' ');

TextColor(Green); {Задание цвета текста}

For I:=1 To N Do

Write(' ',Chr(64+I),' ');

Writeln;

For I:=1 To N Do

Begin

TextColor(Green); {Задание цвета текста}

Write(' ',Chr(64+I),' ');

TextColor(White); {Задание цвета текста}

For J:=1 To N Do

Write(H[I,J]:3,' '); {Вывод текущего элемента матрицы}

Writeln

End;

Readln; {Задержка экрана}

{Вывод полученной матрицы длин путей}

Clrscr; {Очистка экрана}

Writeln('Матрица длин путей');

Writeln;

Write(' ');

TextColor(Green); {Задание цвета текста}

For I:=1 To N Do

Write(' ',Chr(64+I),' ');

Writeln;

For I:=1 To N Do

Begin

TextColor(Green); {Задание цвета текста}

Write(' ',Chr(64+I),' ');

TextColor(White); {Задание цвета текста}

For J:=1 To N Do

Write(T[I,J]:3,' '); {Вывод текущего элемента матрицы}

Writeln

End;

Readln; {Задержка экрана}

Clrscr; {Очистка экрана}

GotoXY(10,10);

Write('Введите номер начальной вершины пути: '); Readln(Nac);

GotoXY(10,12);

Write('Введите номер конечной вершины пути: '); Readln(Kon);

Writeln;

Write('Длина пути из вершины ',Chr(64+Nac),' в вершину ',Chr(64+Kon),' равна: ',T[Nac,Kon]);

Readln {Задержка экрана}

End;

{--------------------------------------------------------------------------}

Procedure Koordinata;

{-----------------------------------}

{Процедура вывода найденных значений}

{-----------------------------------}

Var

Q,W: Real;

K: Char;

X1,X2,Y1,Y2,

X: Integer;

Begin

Open_Graph; {Подключение графического режима}

Q:=2*Pi/N; {Установка значения угла между границами сектора}

{Задание координат вершин графа}

For I:=1 To N Do

Begin

W:=I*Q; {Установка текущего угла}

{Установка координат}

X1:=300+Trunc(R*cos(W)); Y1:=235+Trunc(R*sin(W));

X2:=300+Trunc((R+25)*cos(W)); Y2:=235+Trunc((R+25)*sin(W));

{-------------------}

K:=Chr(64+I); {Задание текущего названия вершины}

SetColor(White); {Задание цвета названий вершин}

OutTextXY(X2,Y2,K); {Вывод названия вершины}

SetColor(Green); {Задание цвета вершины}

For J:=1 To 7 Do

Circle(X1,Y1,J) {Вывод концентрических окружностей для задания вершины на экране}

End;

{Вывод кратчайшего пути}

X:=Nac;

W:=Q*Nac; {Установка текущего угла}

{Установка координат}

X1:=300+Trunc(R*cos(W)); Y1:=235+Trunc(R*sin(W));

{-------------------}

SetColor(Red);

PutPixel(X1,Y1,Red);

Repeat

X:=H[X,Kon]; {Переход на следующую вершину в пути}

W:=Q*X; {Установка текущего угла}

{Установка координат}

X2:=300+Trunc(R*cos(W)); Y2:=235+Trunc(R*sin(W));

{-------------------}

Line(X1,Y1,X2,Y2);

X1:=X2;

Y1:=Y2

Until X=Kon;

SetColor(White);

OutTextXY(3,450,'Press any key, please...');

Readln; {Задержка экрана}

Close_Graph; {Отключение графического режима}

Clrscr

End;

{----------------------------------------------------------------------}

{===========================================================================}

Begin

{-----------------------}

{Основной блок программы}

{-----------------------}

ClrScr; {Очистка экрана}

TextBackGround(Black); {Задание цвета фона}

TextColor(White); {Задание цвета текста}

Clrscr;

Dlina; {Задание длин дуг}

Floid; {Поиск кратчайшего пути и его длины}

Koordinata {Вывод найденных значений}

End.