Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[54.165.122.173] |
|
Сообщ.
#1
,
|
|
|
Мне нужно было используя в точности алгоритм из книжки написать программу. Вот алгоритм
и код программы Uses Crt; Const PP=50; Type Graph = array[1..pp,1..pp] of integer; Var p:integer; Procedure Floyd (var t:graph; c:graph; var h:graph); var i,j,k:integer; GM:real; begin GM:=10000; for i:=1 to p do for j:=1 to p do t[i,j]:=c[i,j]; if c[i,j]=GM then H[i,j]:=0 else begin H[i,j]:=j; end; for i:=1 to p do for j:=1 to p do for k:=1 to p do if (i<>j)and(T[j,i]<>GM)and(i<>k)and (T[i,k]<>GM)and(T[j,k]=GM) or (T[j,k]>T[j,i]+T[i,k]) then begin H[j,k]:=H[j,i]; T[j,k]:=T[j,i]+T[i,k] end; end; Procedure ReadFileGraph (var T:graph); var i,j:integer; f: text; begin Writeln ('Reading from the text file'); Assign (f,'nell.txt'); reset(f); Readln(f,P); for i:=1 to p do for j:=1 to p do read(f,t[i,j]); close(f); end; var t,c,h:graph; i,j: integer; begin ClrScr; ReadFileGraph(c); floyd(t,c,h); writeln('------------------------------------------'); for i:=1 to p do begin for j:=1 to p do write (t[i,j]:3); writeln end; writeln('------------------------------------------'); for i:=1 to p do begin for j:=1 to p do write (h[i,j]:3); writeln end; readln; end. ...и результат В общем что-то мне подсказывает, что матрица путей (это где все нули) должна выглядеть иначе. Файл был вот такой 5 10000 1 3 10000 10000 1 10000 2 10000 10000 4 1 10000 1 2 10000 10000 1 10000 1 10000 10000 2 1 10000 И еще вопрос не по теме. Я когда запускаю программу, она прерывается и выдает ошибку file not found ...но при это созданный exe файл нормально работает, т.е все нашлось и прочиталось. На другом компьютере ошибки нет, с директориями все в порядке. Не знаете в чем дело? |
Сообщ.
#2
,
|
|
|
Цитата nell @ Отсутствуют операторные скобки begin/end.for j:=1 to p do t[i,j]:=c[i,j]; if c[i,j]=GM then H[i,j]:=0 else begin H[i,j]:=j; end; Цитата nell @ У or приоритет ниже, чем у операции and. Опять нужны скобки (уже обычные).if (i<>j)and(T[j,i]<>GM)and(i<>k)and (T[i,k]<>GM)and(T[j,k]=GM) or (T[j,k]>T[j,i]+T[i,k]) Цитата nell @ Зачем тут real? Везде же был integer.GM:real; Цитата nell @ Смени рабочий каталог. И еще вопрос не по теме. Я когда запускаю программу, она прерывается и выдает ошибку file not found ...но при это созданный exe файл нормально работает, т.е все нашлось и прочиталось. На другом компьютере ошибки нет, с директориями все в порядке. Не знаете в чем дело? |
Сообщ.
#3
,
|
|
|
nell как я вижу по книжке Новикова алгоритм нужно сделать ...
вот код реализации данного алгоритма в моем исполнении: 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 .... Прикреплённый файлfloyd.zip (21.26 Кбайт, скачиваний: 729) |
Сообщ.
#4
,
|
|
|
albom Смотрю в книгу - ..вижу непонятно что, это про меня, спасибо, теперь все работает
andrew.virus Когда-нибудь я тоже так смогу... А код я все-таки свой буду сдавать... ну может слегка модифицированный Спасибо огромное, надеюсь со всем разберусь |
Сообщ.
#5
,
|
|
|
andrew.virus
Если ребра нету, то в вводится 0? |
Сообщ.
#6
,
|
|
|
Цитата Sergey_1990 @ Если ребра нету, то в вводится 0? да, если нет ребра то 0, иначе указывается длина пути |
Сообщ.
#7
,
|
|
|
А ты уверен, что прога четко работает? У меня там какая то матрица, длин путей, с нулями вся получается!?
|
Сообщ.
#8
,
|
|
|
Цитата andrew.virus @ nell как я вижу по книжке Новикова алгоритм нужно сделать ... вот код реализации данного алгоритма в моем исполнении: 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 .... andrew.virus твой код на делфи 7 откроется? |
Сообщ.
#9
,
|
|
|
UnknownSpace, откроется но для использования непосредственно в Delphi придется немного подправить код вывода ...
|
Сообщ.
#10
,
|
|
|
Цитата andrew.virus @ пожалуйста, если ты не сильно занят можешь подправить код? За ранее спасибо! |
Сообщ.
#11
,
|
|
|
UnknownSpace, код алгоритма Флойда на Delphi можно посмотреть в статье "Основы поиска путей" ...
з.ы.: там помимо данного алгоритма приведены и другие (алгоритм Дейкстры, воновой алгоритм, ...) с разбором достоинств и недостатков .... |
Сообщ.
#12
,
|
|
|
Цитата andrew.virus @ UnknownSpace, код алгоритма Флойда на Delphi можно посмотреть в статье "Основы поиска путей" ... з.ы.: там помимо данного алгоритма приведены и другие (алгоритм Дейкстры, воновой алгоритм, ...) с разбором достоинств и недостатков .... Дядька, мне нужна реализация ИМЕННО твоего кода, который ты выкладывал! =.( |
Сообщ.
#13
,
|
|
|
andrew.virus,
Добрый день! Хотел у вас узнать: методы описанные в статье возможно ли применить в Excel VBA к поиску маршрута по схеме (схема состоит из фигур Shapes и присоединенных/наложенных к ним линий)? |