На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! правила раздела Алгоритмы
1. Помните, что название темы должно хоть как-то отражать ее содержимое (не создавайте темы с заголовком ПОМОГИТЕ, HELP и т.д.). Злоупотребление заглавными буквами в заголовках тем ЗАПРЕЩЕНО.
2. При создании темы постарайтесь, как можно более точно описать проблему, а не ограничиваться общими понятиями и определениями.
3. Приводимые фрагменты исходного кода старайтесь выделять тегами code.../code
4. Помните, чем подробнее Вы опишете свою проблему, тем быстрее получите вразумительный совет
5. Запрещено поднимать неактуальные темы (ПРИМЕР: запрещено отвечать на вопрос из серии "срочно надо", заданный в 2003 году)
6. И не забывайте о кнопочках TRANSLIT и РУССКАЯ КЛАВИАТУРА, если не можете писать в русской раскладке :)
Модераторы: Akina, shadeofgray
  
> алгоритм Флойда
    Мне нужно было используя в точности алгоритм из книжки написать программу. Вот алгоритм
    user posted image
    и код программы
    ExpandedWrap disabled
      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.

    ...и результат
    user posted image
    В общем что-то мне подсказывает, что матрица путей (это где все нули) должна выглядеть иначе.
    Файл был вот такой
    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 файл нормально работает, т.е все нашлось и прочиталось. На другом компьютере ошибки нет, с директориями все в порядке. Не знаете в чем дело?
      Цитата nell @
      ExpandedWrap disabled
        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;
      Отсутствуют операторные скобки begin/end.


      Цитата nell @
      ExpandedWrap disabled
        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])
      У or приоритет ниже, чем у операции and. Опять нужны скобки (уже обычные).

      Цитата nell @
      ExpandedWrap disabled
        GM:real;
      Зачем тут real? Везде же был integer.

      Цитата nell @
      И еще вопрос не по теме. Я когда запускаю программу, она прерывается и выдает ошибку file not found ...но при это созданный exe файл нормально работает, т.е все нашлось и прочиталось. На другом компьютере ошибки нет, с директориями все в порядке. Не знаете в чем дело?
      Смени рабочий каталог.
        nell как я вижу по книжке Новикова алгоритм нужно сделать ... 8-)

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

        ExpandedWrap disabled
          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 Кбайт, скачиваний: 728)
          albom Смотрю в книгу - ..вижу непонятно что, это про меня, спасибо, теперь все работает
          andrew.virus Когда-нибудь я тоже так смогу... А код я все-таки свой буду сдавать... ну может слегка модифицированный :) Спасибо огромное, надеюсь со всем разберусь
            andrew.virus

            Если ребра нету, то в вводится 0?
              Цитата Sergey_1990 @
              Если ребра нету, то в вводится 0?

              да, если нет ребра то 0, иначе указывается длина пути
                А ты уверен, что прога четко работает? У меня там какая то матрица, длин путей, с нулями вся получается!?
                  Цитата andrew.virus @
                  nell как я вижу по книжке Новикова алгоритм нужно сделать ... 8-)

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

                  ExpandedWrap disabled
                    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 откроется?
                    UnknownSpace, откроется но для использования непосредственно в Delphi придется немного подправить код вывода ...
                      Цитата andrew.virus @

                      пожалуйста, если ты не сильно занят можешь подправить код?
                      За ранее спасибо!
                        UnknownSpace, код алгоритма Флойда на Delphi можно посмотреть в статье "Основы поиска путей" ...

                        з.ы.: там помимо данного алгоритма приведены и другие (алгоритм Дейкстры, воновой алгоритм, ...) с разбором достоинств и недостатков ....
                          Цитата andrew.virus @
                          UnknownSpace, код алгоритма Флойда на Delphi можно посмотреть в статье "Основы поиска путей" ...

                          з.ы.: там помимо данного алгоритма приведены и другие (алгоритм Дейкстры, воновой алгоритм, ...) с разбором достоинств и недостатков ....

                          Дядька, мне нужна реализация ИМЕННО твоего кода, который ты выкладывал! =.(
                            andrew.virus,
                            Добрый день! Хотел у вас узнать: методы описанные в статье возможно ли применить в Excel VBA к поиску маршрута по схеме (схема состоит из фигур Shapes и присоединенных/наложенных к ним линий)?
                            Сообщение отредактировано: Ильнур -
                            0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                            0 пользователей:


                            Рейтинг@Mail.ru
                            [ Script execution time: 0,0552 ]   [ 16 queries used ]   [ Generated: 19.03.24, 10:29 GMT ]