На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! Друзья, соблюдайте, пожалуйста, правила форума и данного раздела:
Данный раздел не предназначен для вопросов и обсуждений, он содержит FAQ-заготовки для разных языков программирования. Любой желающий может разместить здесь свою статью. Вопросы же задавайте в тематических разделах!
• Если ваша статья может быть перенесена в FAQ соответствующего раздела, при условии, что она будет оформлена в соответствии с Требованиями к оформлению статей.
• Чтобы остальным было проще понять, указывайте в описании темы (подзаголовке) название языка в [квадратных скобках]!
Модераторы: Модераторы
  
> Требуется!, [Pascal] описание алгоритмов работы с графами
    Требуется описание алгоритмов для работы с графами.
    • Поиск в ширину
    • Поиск в глубину
    • Вычисление матрицы достижимости
    • другие?

    Нужно описать алгоритмы и реализовать их в виде процедур, объяснив что просходит и почему. :rolleyes:

    Планируется разместить их здесь: http://sources.ru/wiki/doku.php?id=pascal:graph

    Кто возьмётся? ;)
    Сообщение отредактировано: Jin X -
      Romtek, в книге "Структуры данных и алгоритмы" (Ахо, Хопрофт, Ульман) теме алгоритмов на графах посвящены 2 главы: 6-я ("Ориентированные графы") и 7-я ("Неориентированные графы"), итого - страницы 183-227 (со схемами, примерами программ, теоретическими обоснованиями, и т.д.) Полнее вряд ли что-то можно себе представить...

      Можно, конечно это переконвертировать из DJVU в другой формат и выложить в FAQ-е, но что будем делать с (С)?
        volvo877, держать копию бумажных книг не есть цель FAQ, а собирание наиболее популярных алгоритмов и их реализация на Паскале. Книгу мы не в состоянии заменить, да и нет нужды.
          Матрица достижимости:
          ExpandedWrap disabled
            procedure AttainAbility (var P :TMatrix; S :TMatrix);
            var
              i, j, k :Integer;
              T :TMatrix;
             
              { Булева сумма }
              procedure BSum(var T :TMatrix; A, B :TMatrix);
              var
                i, j :Integer;
              begin
                fillchar(T, sizeof(T), 0);
                for i:=1 to NMax do
                  for j:=1 to NMax do
                    T[i,j] := A[i,j] or B[i,j];
              end;
             
              { Булево произведение }
              procedure BMult(var T :TMatrix; A, B :TMatrix);
              var
                i, j, k :Integer;
                temp :TMatrix;
              begin
                fillchar(T, sizeof(T), 0);
                for i:=1 to NMax do
                  for j:=1 to NMax do
                    for k:=1 to NMax do T[i,j] := T[i,j] or (A[i,k] and B[k,j]);
              end;
             
            begin
              P := S; BMult(T, S, S);
              for i:=2 to NMax do begin
                BSum(P, P,T); BMult(T, T,S);
              end;
            end;


          S - матрица смежности
          P - матрица достижимости

          Типы описаны так:
          ExpandedWrap disabled
            Const NMax = 4;
            Type
              TVector = array[1..NMax] of Boolean;
              TMatrix = array[1..NMax] of TVector;
          Сообщение отредактировано: Artful Fox -
            Artful Fox, благодарю за код. ;)
            А как насчёт пояснения как и почему?.
              Цитата Romtek @
              А как насчёт пояснения как и почему?.

              Хорошо.

              P - искомая матрица достижимости. Известно, что P = A (булева сумма) A^2 (булева сумма) A^3 (булева сумма) .... (булева сумма) A^n, где A - матрица смежности, n - размерность матрицы (число вершин в графе), причем A^2 = A (булево произведение) A, а для общего случая A^r = A (булево произведение) A^r-1.

              Булева сумма и произведение пишутся как и для обычных матриц.
                Обход графа в глубину:
                ExpandedWrap disabled
                    procedure Go (S :TMatrix);
                    var
                      i :Integer;
                      B :array[1..NMax] of Boolean;
                   
                      procedure GoDown (m :Integer);
                      var i :Integer;
                      begin
                        write(m);
                        B[m] := true;
                        for i:=1 to NMax do
                          if (S[m,i]) and (not B[i]) then GoDown(i);
                      end;
                   
                    begin
                      fillchar(B,sizeof(B),0);
                      for i:=1 to Nmax do GoDown(i);
                    end;


                Кстати я заметил, что предыдущий алгоритм нахождения матрицы достижимости можно использовать как для орграфов так и для обычных. Но для обычных можно использовать и следующий алгоритм основанный на обходе в глубину:
                ExpandedWrap disabled
                  procedure AttainAbility(var P :TMatrix; S :TMatrix);
                    var
                      B :TVector;
                      i :Integer;
                   
                      procedure GoDown (m :Integer);
                      var i :Integer;
                      begin
                        B[m] := true;
                        for i:=1 to NMax do
                          if (not B[i]) and S[m,i] then GoDown(i);
                      end;
                   
                    begin
                      for i:=1 to NMax do begin
                        FillChar(B,SizeOf(B),0);
                        GoDown(i);
                        P[i] := B;
                      end;
                    end;
                  Немного о графах есть здесь:
                  http://education.aspu.ru/page.php?id=152

                  Добавлено
                  поиск в глубину
                  Поиск в ширину
                  Каркасы (стягивающие деревья)
                  Построение стягивающего дерева поиском в глубину
                  Построение стягивающего дерева поиском в ширину
                  Построение всех каркасов графа
                  Построение минимального каркаса методом Краскала: Граф задан списком ребер с указанием их весов
                  Построение минимального каркаса методом Прима
                  и Поиск кратчайших путей.
                  http://education.aspu.ru/page.php?id=152

                  Добавлено
                  Сборник исходников "Алгоритмы на графах" : есть много всего интересного
                  http://borisvolfson.h11.ru/programs/graphs.rar
                  user posted image
                    Без пояснений алгоритмом и в коде нет смысла в данных ссылках, поисковиками все умеют пользоваться.
                      Дейкстра с бинарным деревом (heap'ом) в НГ
                      Способ представления графа: списки смежности

                      ExpandedWrap disabled
                        program DijkstraViaHeap_01;
                        const
                          FIN  = 'dijkstra.in';
                          FOUT  = 'dijkstra.out';
                          NMAX = 30000;
                          INF  = high(integer) div 2 - 1;
                        type
                          PEdge = ^TEdge;
                          TVertex = record
                            num: integer;
                            key: integer;
                            end;
                          THeap = class
                            a: array of TVertex;
                            index_by_num: array of integer;
                            length: integer;
                            function LChild(const k: integer): integer;
                            function RChild(const k: integer): integer;
                            function Parent(const k: integer): integer;
                            procedure Add(var v: TVertex); overload;
                            procedure Add(const num, key: integer); overload;
                            procedure Swap(const i, j: integer);
                            procedure Update(const num: integer; const new_key: integer);
                            function ExtractMin(): TVertex;
                            constructor Create(const allocSize: integer); overload;
                            constructor Create(const allocSize: integer; const keys: array of integer); overload;
                            end;
                          TEdge = record
                            v: integer;
                            w: integer;
                            next: PEdge;
                            end;
                         
                        procedure THeap.Add(const num, key: integer);
                        var v: TVertex;
                        begin
                          v.num := num;
                          v.key := key;
                          add(v);
                        end;
                         
                        constructor THeap.Create(const allocSize: integer);
                        var i: integer;
                        begin
                          length := 0;
                          setlength(a, allocSize);
                          setlength(index_by_num, allocSize);
                          for i := 0 to allocSize - 1 do index_by_num[i] := -1;
                        end;
                         
                        constructor THeap.Create(const allocSize: integer; const keys: array of integer);
                        var i: integer;
                            v: TVertex;
                        begin
                          length := 0;
                          setlength(a, allocSize);
                          setlength(index_by_num, allocSize);
                          for i := 0 to allocSize - 1 do index_by_num[i] := -1;
                          for i := 0 to allocSize - 1 do begin
                             v.num := i + 1;
                             v.key := keys[i];
                             add(v);
                            end;
                        end;
                         
                        function THeap.LChild(const k: integer): integer;
                        begin
                          result := 2 * k + 1;
                        end;
                         
                        function THeap.RChild(const k: integer): integer;
                        begin
                          result := 2 * (k + 1);
                        end;
                         
                        function THeap.Parent(const k: integer): integer;
                        begin
                          if k = 0 then result := -1
                          else result := (k - 1) div 2;
                        end;
                         
                        procedure THeap.Swap(const i, j: integer);
                        var t: TVertex;
                        begin
                          index_by_num[a[i].num - 1] := j;
                          index_by_num[a[j].num - 1] := i;
                         
                          t    := a[i];
                          a[i] := a[j];
                          a[j] := t;
                        end;
                         
                        procedure THeap.Add(var v: TVertex);
                        var k, p: integer;
                        begin
                          inc(length);
                          k := length - 1;
                          a[k] := v;
                          index_by_num[v.num - 1] := k;
                          p := parent(k);
                          while (p <> -1) and (a[p].key > a[k].key) do begin
                            swap(p, k);
                            k := p;    
                            p := parent(k);
                            end;
                        end;
                         
                        function THeap.ExtractMin(): TVertex;
                        var new_key: integer;
                        begin
                          result := a[0];
                          swap(0, length - 1);
                          dec(length);
                          index_by_num[result.num - 1] := -1;
                          new_key := a[0].key;
                          a[0].key := result.key;
                          update(a[0].num, new_key);
                        end;
                         
                        procedure THeap.Update(const num: integer; const new_key: integer);
                        var k, p, c1, c2: integer;
                        begin
                          k := index_by_num[num - 1];
                          if (k = -1) or (k > length - 1) then exit;
                          if new_key < a[k].key then begin
                            a[k].key := new_key;
                            p := parent(k);
                            while (p <> -1) and (a[p].key > a[k].key) do begin
                              swap(p, k);
                              k := p;
                              p := parent(k);
                              end;
                            end
                          else begin
                            a[k].key := new_key;
                            while true do begin
                              c1 := lchild(k);
                              c2 := rchild(k);
                              p := k;
                              if (c1 < length) and (a[c1].key < a[p].key) then p := c1;
                              if (c2 < length) and (a[c2].key < a[p].key) then p := c2;
                              if p = k then break;
                              swap(p, k);
                              k := p;
                              end;
                            end;
                        end;
                         
                        procedure addEdge(var l: PEdge; const v, w: integer);
                        var t: PEdge;
                        begin
                          new(t);
                          t.next := l;
                          t.v := v;
                          t.w := w;
                          l := t;
                        end;
                         
                        var
                          n, m: integer;
                          e: array[1..NMAX] of PEdge;
                         
                        procedure Dijkstra(const s, t: integer);
                        var i: integer;
                            min: integer;
                            cur: PEdge;
                            heap: THeap;
                            dist: array[1..NMAX] of integer;
                            prev: array[1..NMAX] of integer;
                        begin
                          for i := 1 to n do begin
                            dist[i] := INF;
                            prev[i] := -1;
                            end;
                          prev[s] := 0;
                          dist[s] := 0;
                          heap := THeap.Create(n, dist);
                          while heap.length > 0 do begin
                            min := heap.ExtractMin().num;
                            cur := e[min];
                            while cur <> nil do begin
                              if dist[cur.v] > dist[min] + cur.w then begin
                                prev[cur.v] := min;
                                dist[cur.v] := dist[min] + cur.w;
                                heap.update(cur.v, dist[cur.v]);
                                end;
                              cur := cur.next;
                              end;
                            end;
                          for i := 1 to n - 1 do write(dist[i], ' ');
                          writeln(dist[n]);
                        end;
                         
                        var i, u, v, w: integer;
                        begin
                          AssignFile(input, FIN);   reset(input);
                          AssignFile(output, FOUT); rewrite(output);
                          read(n, m);
                          for i := 1 to m do begin
                            read(u, v, w);
                            addEdge(e[u], v, w);
                            addEdge(e[v], u, w);
                            end;
                          Dijkstra(1, 0);
                          close(input);
                          close(output);
                        end.


                      Время работы O(v * log(v) + e * log(e)), где v и t кол-во вершин и рёбер соответственно.
                      Красивое подробное пояснение с картинками http://ru.wikipedia.org/wiki/Алгоритм_Дейкстры

                      Дейсктра на массиве и ОГ
                      Способ представления графа: списки смежности
                      ExpandedWrap disabled
                        program DijkstraViaArray_01;
                        {$Q+} {$R+}
                        {/$DEFINE FILE_IO}
                         
                        uses
                          SysUtils;
                         
                        const
                          NMAX = 1000;
                          INF   = high(Integer) div 2 - 1;
                          INF64 = 100000000000000;
                         
                        type
                          PEdge = ^TEdge;
                          TEdge = record
                            v: integer;
                            w: integer;
                            next: PEdge;
                            end;
                         
                          procedure addEdge(var l: PEdge; const v: integer; const w: integer);
                          var t: PEdge;
                          begin
                            new(t);
                            t.next := l;
                            t.v := v;
                            t.w := w;
                            l := t;
                          end;
                         
                        var
                          n, m: integer;
                          s, t: integer;
                         
                         
                        procedure solve(s, t: integer);
                        var i: integer;
                            dist: array[0..NMAX] of int64;
                            prev: array[1..NMAX] of integer;
                            used: array[1..NMAX] of byte;
                            e: array[1..NMAX] of PEdge;
                         
                            path: string;
                            path_length: integer;
                            u, v, w: integer;
                            min: integer;
                            cur: PEdge;
                        begin
                          for i := 1 to NMAX do begin
                            e[i] := nil;
                            dist[i] := INF64;
                            prev[i] := -1;
                            used[i] := 0;
                            end;
                         
                          for i := 1 to m do begin
                            read(u, v, w);
                            if (u = v) then continue;
                            addEdge(e[u], v, w);
                            end;
                         
                          dist[s] := 0;
                          prev[s] := 0;
                          used[s] := 1;
                          dist[0] := INF64;
                          fillchar(used, sizeof(used), 0);
                          while true do begin
                         
                            min := 0;
                            for i := 1 to n do begin
                              if (used[i] = 0) and (dist[i] < dist[min])
                                then min := i;
                              end;
                            if min = 0 then break;
                         
                            used[min] := 1;
                         
                            cur := e[min];
                            while cur <> nil do begin
                              if (Int64(dist[cur.v] - dist[min]) - Int64(cur.w) > 0) then begin
                                prev[cur.v] := min;
                                dist[cur.v] := Int64(dist[min]) + Int64(cur.w);
                                end;
                              cur := cur.next;
                              end;
                         
                            end;
                         
                          if dist[t] = INF64 then begin
                            writeln('-1');
                            exit;
                            end;
                         
                          write(dist[t], ' ');
                          path := '';
                          path_length := 0;
                          while t <> 0 do begin
                            path := inttostr(t) + ' ' + path;
                            t := prev[t];
                            inc(path_length);
                            end;
                          if path_length <> 0 then
                            setlength(path, length(path) - 1);
                          Writeln(path_length);
                          writeln(path);
                        end;
                         
                        begin
                          {$IFDEF FILE_IO}
                          assign(input, 'dijkstra.in'); reset(input);
                          assign(output, 'dijkstra.out'); rewrite(output);
                          {$ENDIF}
                         
                          read(n, m);
                          read(s, t);
                          solve(s, t);
                        end.




                      Дейсктры в ОГ и в НГ ничем не отличаются друг от друга в реализации.
                      Хотелось бы переделать объяснение работы (или хотя бы взять его из Кормена), но времени как всегда нет..

                      Добавлено
                      Поиск в ширину на списках смежности

                      ExpandedWrap disabled
                        program BFS_01;
                        uses Contnrs;
                        const
                          FIN  = 'breadth.in';
                          FOUT = 'breadth.out';
                          NMAX = 30000;
                          INF  = high(integer) div 2 - 1;
                        type
                          PEdge = ^TEdge;
                          TEdge = record
                            v: integer;
                            next: PEdge;
                            end;
                         
                        procedure addEdge(var l: PEdge; const v: integer);
                        var t: PEdge;
                        begin
                          new(t);
                          t.next := l;
                          t.v := v;
                          l := t;
                        end;
                         
                        var
                          e: array[1..NMAX] of PEdge;
                          m: integer;
                          n: integer;
                         
                        procedure BFS(const s, f: integer);
                        var i: integer;
                            t: PInteger;
                            cur: PEdge;
                            min: integer;
                            queue: TQueue;
                            dist: array[1..NMAX] of integer;
                            prev: array[1..NMAX] of integer;
                        begin
                          for i := 1 to n do begin
                            dist[i] := INF;
                            prev[i] := -1;
                            end;
                         
                          prev[s] := 0;
                          dist[s] := 0;
                         
                          queue := TQueue.Create;
                          new(t);
                          t^ := s;
                          queue.Push(t);
                         
                          while queue.Count > 0 do begin
                            t := queue.Pop;
                            cur := e[t^];
                            min := t^;
                         
                            while cur <> nil do begin
                              if dist[cur.v] > dist[min] then begin
                                prev[cur.v] := min;
                                dist[cur.v] := dist[min] + 1;
                                new(t);
                                t^ := cur.v;
                                queue.Push(t);
                                end;
                              cur := cur.next;
                              end;
                         
                            end;
                         
                          for i := 1 to n - 1 do write(dist[i], ' ');
                          writeln(dist[n]);
                        end;
                         
                        var i, u, v: integer;
                        begin
                          AssignFile(input, FIN);   reset(input);
                          AssignFile(output, FOUT); rewrite(output);
                          read(n, m);
                          for i := 1 to m do begin
                            read(u, v);
                            addEdge(e[u], v);
                            addEdge(e[v], u);
                            end;
                          BFS(1, 0);
                          close(input);
                          close(output);
                        end.

                      O(v + e)

                      Rem. Здесь использована стандартная Дельфийская очередь, не используйте её никогда, т. к. она медленная!


                      Алгоритм Флойда
                      ExpandedWrap disabled
                        program Floyd;
                        const
                          FIN  = 'floyd.in';
                          FOUT = 'floyd.out';
                          INF = high(integer) div 2 - 1;
                          NMAX = 300;
                         
                        var A: array[1..NMAX, 1..NMAX] of integer;
                            i, j, k, w, n, u, v, m: integer;
                        begin
                          AssignFile(input, FIN);   reset(input);
                          AssignFile(output, FOUT); rewrite(output);
                          read(n, m);
                         
                          for i := 1 to n do begin
                            for j := 1 to n do begin
                              A[i, j] := INF;
                              end;
                            A[i, i] := 0;
                            end;
                         
                         
                          for i := 1 to m do begin
                            read(u, v, w);
                            A[u, v] := w;
                            end;
                         
                          // Ищем расстояния от всех вершин до всех
                          for k := 1 to n do begin
                            for i := 1 to n do begin
                              for j := 1 to n do begin
                                if A[i, j] > A[i, k] + A[k, j] then
                                  A[i, j] := A[i, k] + A[k, j];
                                end;
                              end;
                            end;
                         
                          // Проверяем наличие циклов отрицательного веса
                          for i := 1 to n do begin
                            for j := 1 to n do begin
                              if A[i, j] = INF then write('-1 ')
                              else write(A[i, j], ' ');
                              end;
                            writeln;
                            end;
                         
                          close(input);
                          close(output);
                        end.

                      O(v^3)

                      Алгоритм Форда-Беллмана

                      Просто V-1 раз релаксируем все рёбра, на каждом шаге найдены все кратчайшие пути из i рёбер

                      ExpandedWrap disabled
                        program Ford_Bellman1;
                        const
                          FIN  = 'fordbell.in';
                          FOUT = 'fordbell.out';
                          NMAX = 200;
                          INF  = high(integer) div 2 - 1;
                         
                        type
                          PEdge = ^TEdge;
                          TEdge = record
                            u, v, w: integer;
                            next: PEdge;
                            end;
                         
                        procedure addEdge(var l: PEdge; const u, v, w: integer);
                        var t: PEdge;
                        begin
                          new(t);
                          t.next := l;
                          t.u := u;
                          t.v := v;
                          t.w := w;
                          l := t;
                        end;
                         
                        var
                          n: integer;
                          m: integer;
                          e: PEdge;
                         
                        procedure Ford_Bellman(const s, t: integer);
                        var i, k: integer;
                            cur: PEdge;
                            dist: array[1..NMAX] of integer;
                            prev: array[1..NMAX] of integer;
                        begin
                          for i := 1 to n do begin
                            dist[i] := INF;
                            prev[i] := -1;
                            end;
                         
                          prev[s] := 0;
                          dist[s] := 0;
                         
                          for k := 1 to n - 1 do begin
                            cur := e;
                            for i := 1 to m do begin
                              if dist[cur.v] > dist[cur.u] + cur.w then begin
                                dist[cur.v] := dist[cur.u] + cur.w;
                                prev[cur.v] := cur.u;
                                end;
                              cur := cur.next;
                              end;
                            end;
                         
                          for i := 1 to n - 1 do write(dist[i], ' ');
                          writeln(dist[n]);
                        end;
                         
                        var i, u, v, w: integer;
                        begin
                          AssignFile(input, FIN);   reset(input);
                          AssignFile(output, FOUT); rewrite(output);
                          read(n, m);
                         
                          for i := 1 to m do begin
                            read(u, v, w);
                            addEdge(e, u, v, w);
                            end;
                         
                          Ford_Bellman(1, 0);
                         
                          close(input);
                          close(output);
                        end.

                      O(v * e)



                      Итак, у меня есть ещё десяток алгоритмов, пока попытаюсь найти время на пояснение этих :rolleyes:
                      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                      0 пользователей:


                      Рейтинг@Mail.ru
                      [ Script Execution time: 0,1399 ]   [ 17 queries used ]   [ Generated: 22.07.19, 06:28 GMT ]