Вот тут думаю изложить основы реализации теории графов на Паскале. Просьба не судить слишком строго - первый опыт. А если критиковать, то с подсказками.
При написании буду в основном пользоваться: Кормен, Лейзерсон, Ривест - Алгоритмы. Построение и анализ

1. Представление графов
Есть два основных способа представить граф: в виде списков смежных вершин и матрицы смежности. Первый предпочтительнее для разреженных графов, в которых количество ребер E намного больше V^2.
Представление графа в виде списков смежных вершин использует массив из V списков - по одному списку на вершину. Для каждой вершины список содержит в произвольном порядке все смежные с ней вершины.
Вот как эта структура данных будет выглядеть в Паскале

Код

const VMax  = 100; type Spisok = ^List; List = record    weight:integer;    next:spisok; end; var a:array[1..VMax] of spisok;

При использовании матрицы смежности мы нумеруем вершины графа числами 1,2,...,V и рассматриваем матрицу A, в которой a[i,j]=1 если есть ребро между вершинами i и j и a[i,j]=0в противном случае. В случае взвешенного графа, вместо единицы в a[i,j] удобно хранить вес ребра.
Минус этого метода заключается в том, что матрица занимает V^2 памяти независимо от количества ребер в графе.
В Паскале матрица будет выглядеть так:

Код

const  VMax=100; var  b:array[1..VMax,1..VMax] of integer;

2. Поиск в ширину
Поиск в ширину - один из базовых алгоритмов теории графов. Он является основой для многих других алгоритмов.
Пусть задан граф и виксированная начальная вершина s. Алгоритм поиска в ширину перечисляет все достижимые из s (если идти по ребрам) вершины в порядке возрастания расстояния от s. В процессе поиска из графа выделяется часть, которая называется деревом поиска в ширину с корнем в s. Она содержит все достижимые из s вершины (и только их).
Для наглядности будем считать, что в процессе работы алгоритма вершины графа могут быть белыми, серыми и черными. Сначала они все белые, а в ходе работы алгоритма белая вершина может стать серую, серая - черной, но не наоборот. Встретив новую вершину, алгоритм поиска красит ее, так что серые и черные вершины - уже обнаруженные вершины.
Сначала дерево поиска в ширину состоит только из начальной вершины s. Как только алгоритм находит новую вершину v, смежную с ранее найденной вершиной u, вершина v вместе с ребром (u,v) добавляется к дереву поиска и становится потомком u. Каждая вершина обнаруживается только один раз, так что двух родителей у вершины быть не может.
Оценивая сложность работы этого алгоритма замечаем, что вершины только темнеют, то есть важдая вершина обрабатывается только один раз, т.е. вычислительная сложность алгоритма O(V+E).
Алгоритм:

Цитата

BFS(G,s) for (для) кожної вершини з G - {s}       do p[i]= NIL         d[i]= MAX         color[i]= БІЛИЙ color[s]= СІРИЙ d[s]= 0 p[i]= NIL Q <- {s} while Q  - не пусте     do u <- Dequeue(Q)         for (для) всіх v - нащадків u             do color[v]= СІРИЙ                 p[v]= u                 d[v]= d[u]+1         color[u]= ЧОРНИЙ

Реализация на Паскале с использованием матрицы смежности

Код

var  Q:array[1..100] of byte;   {очередь}  left,right:byte; procedure Enqueue(x:word); {процедура добавления в очередь вершины} begin   Q[right]:=x;   if right=100 then right:=1 else inc(right); end; procedure Dequeue;              {процедура удаления из очереди вершины} begin   if left=100 then left:=1 else inc(left); end; var  G:array[1..100,1..100] of word;  {граф}  i,j,k,h:word;  d:array[1..100] of word;             {массив расстояний}  p:array[1..100] of word;             {массив предков}  color:array[1..100] of byte;         {массив цветов}  n:word;  fin:text;  beg:word;                                   {начальная вершина} begin  k:=0; {чтение графа из файла, имя которого - первый параметр командной строки}  assign(fin,paramstr(1)); reset(fin);  read(fin,n); readln(fin,beg);  while not EOF(fin) do    begin      read(fin,i); readln(fin,j);      g[i,j]:=1; g[j,i]:=1;    end;  close(fin); {конец чтения из файла} {инициализация массивов}  for i:=1 to n do    begin      color[i]:=0;      d[i]:=65535;      p[i]:=0;    end; {конец инициализации массивов} color[beg]:=1; d[beg]:=0; p[beg]:=0; left:=1; right:=1; Enqueue(beg);             {добавление первой вершины в очередь} while left<>right do      {пока очередь не пуста}   begin     k:=Q[left];     for i:=1 to n do        {для всех вершин...}       if g[k,i]=1 then       {...смежных с k...}       begin         if color[i] = 0 then {...если мы ее еще не обрабатывали...}           begin             color[i]:=1;       {...сделать цвет серым...}             d[i]:=d[k]+1;    {...указать расстояние...}             p[i]:=k;             {...указать предка...}             EnQueue(i);      {...добавить в очередь}           end;       end;     Dequeue;                {удалить из очереди}     color[k]:=2;             {сделать цвет черным: вершина полностью обработана}   end; {вывод на экран расстояния от s до всех вершин, достигаемых из нее} for i:=1 to n do   write(d[i],' ');   writeln; end.

3. Поиск в глубину
Поиск в глубину - еще один способ обхода графа. Он используется в таких алгоритмах, как алгоритм топологической сортировки, алгоритм поиска сильно связанных компонент.
Стратегия поиска в глубину такова: идти вглубь пока это возможно (есть непройденные исходящие ребра), возвращатся и искать другой путь когда таких ребер не существует. Если после этого остаются неиспользованные вершины - можно выбрать одну из них и повторять процесс пока остаются необнаруженные вершины.
Найдя впервые вершину v, смежную с u, ми отмечаем это событие, записывая в поле p[v] значение u. Таким образом образуется дерево или несколько деревьев.
Как и поиск в ширину, алгоритм поиска в глубину использует цвета вершин. Сначала все вершины - белые. При обнаружении новой вершины, она красится в серый цвет. Когда вершина полностью обработана, она перекрашивается в черный цвет.
Кроме этого, поиск в глубину ставит на вершинах метки времени. Каждая вершина имеет две метки: d[v] показывает, когда вершина была обнаружена, f[v] - когда обработана. Эти метки впоследствии используются во многих алгоритмах на графах.
Во время выполнения этого алгоритма, обработка каждой вершины происходит ровно один раз. Общее же количество выполнения строк 3 - 6 процедуры DFS-Visit составляет O(E). В итоге сложность данного алгоритма составляет O(V+E), где V - количество вершин в графе, а E - количество ребер.

Алгоритм:

Цитата

DFS 1 for (для) всех вершин u 2        do color[u]= БЕЛЫЙ 3          parent[u]= NIL 4 time=0 5 for (для) всех вершин u 6  do if color[u]=БЕЛЫЙ 7  then DFS-Visit[u] DFS-Visit(u) 1 color[u]=СЕРЫЙ 2 d[u]=time 3 time=time+1 4 for (для) всех v (потомков u) 5      do if color[v]=БЕЛЫЙ 6            then parent[v]=u 7                DFS-Visit(v) 8 color[u]=ЧЕРНЫЙ 9 f[u]=time 10 time=time+1

Реализация на Паскале с помощью матрицы смежности:

Код

var  fin:text;  g:array[1..100,1..100] of word;           {матрица смежности}  N:word;  d,f:array[1..100] of word;                    {массивы меток}  p:array[1..100] of word;                      {массив предков}  color:array[1..100] of byte;                 {массив цветов}  time:word;                                           {счетчик времени} procedure DFS_visit(u:word); var   i,j:word; begin   color[u]:=1;                                        {"окрашиваем"вершину u в серый цвет}   inc(time);   d[u]:=time;   for i:=1 to n do     if g[u,i]=1 then                                 {Если есть ребро из u в i...}       if color[i]=0 then                             {... то если цвет i белый (мы ее еще не обрабатывали)...}         begin           p[i]:=u;                                       {...предок i - v...}           DFS_Visit(i);                                {...вызываем рекурсивно процедуру для вершины i}         end;                                                              {после выполнения цикла мы гарантируем, что обработали                                                                 все смежные u необработанные вершины}   color[u]:=2;                                        {помечаем u как обработанную}   inc(time);   f[u]:=time; end; var   i,j:word; begin  {читаем информацию про граф из файла, заданного первым параметром командной строки}  {граф задан так: первая строка файла - колличество вершин. В каждой следующей строке - два числа i и j. Это означает, что в графе существует ребро i->j}  assign(fin,paramstr(1)); reset(fin);  readln(fin,n);  while not EOF(fin) do    begin      read(fin,i); readln(fin,j);      g[i,j]:=1;    end;  close(fin);  {граф прочитан}  {обнуляем массивы предков и цветов}  for i:=1 to n do    begin      color[i]:=0;      p[i]:=0;    end;  for i:=1 to n do    if color[i]=0 then      DFS_Visit(i);  {в этот момент построенно дерево поиска, которое находится в массиве p, известно, на каком шаге каждая вершины вошла в поиск. Эту информацию можно использовать как данные для других алгоритмов} end.

4. Топологическая сортировка

Пусть имеется ориентированный граф без циклов. Задача о топологической сортировке этого графа состоит в следующем: надо указать такой линейный порядок на его вершинах, что любое ребро ведет от меньшей вершины к большей (в смысле этого порядка). Очевидно, что если в графе есть циклы, то такого порядка не существует. Можно сформулировать задачу о топологической сортировке и так: расположить вершины графа на горизональной прямой так, что чтобы все ребра шли слева направо.
Во пример ситуации, когда возникает побобная задача: во время обучения программированию, какие-то темы нужно учить раньше других. Например, циклы нужно обязательно знать до изучения реализации теории графов. В некоторых случаях порядок не имеет значения (например, алгоритмы вычислительной геометрии можно учить как перед изучением теории графов, так и после).
Мы составляем граф по следующем принципу: существует ребро (u,v) если тема u должна быть изучена перед прохождением темы v. Тем самым, топологическая сортировка описывает возможный порядок изучения тем.

Алгоритм топологической сортировки предельно прост. Он основан на описанном выше алгоритме поиска в глубину.

Цитата

Topological-Sort 1 вызвать DFS(G), при этом 2    завершая обработку вершины (DFS-Visit, строка 8), добавлять ее в начало списка 3 вернуть построенный список вершин

И реализация топологической сортировки на Паскале. Граф задан матрицей смежности.

Код

var  fin:text;  g:array[1..100,1..100] of word;    {матрица смежности}  N:word;  spisok:array[1..100] of word;       {массив. в котором будет результат}  top:word; {Реализация алгоритма поиска в глубину уже описана и прокомментирована, тут прокомментируем только отличия, которіе присущи реализации в топологической сортировке} procedure DFS; var  d,f:array[1..100] of word;  p:array[1..100] of word;  color:array[1..100] of byte;  time:word;  i:word; procedure DFS_visit(u:word); var   i,j:word; begin   color[u]:=1;   inc(time);   d[u]:=time;   for i:=1 to n do     if g[u,i]=1 then       if color[i]=0 then         begin           p[i]:=u;           DFS_Visit(i);         end;   color[u]:=2;   inc(time);   f[u]:=time;   inc(top);                {увеличиваем количество элементов в результате на один}   spisok[top]:=u;     {добавляем вершину u в список} end; begin   for i:=1 to n do    begin      color[i]:=0;      p[i]:=0;    end;  for i:=1 to n do    if color[i]=0 then      DFS_Visit(i); end; {Закончилась реализация алгоритма поиска в глубину} var i,j:word; begin  top:=0; {Считываем из текстового файла. Граф в фалйе задан как обычно} assign(fin,paramstr(1)); reset(fin);  readln(fin,n);  while not EOF(fin) do    begin      read(fin,i); readln(fin,j);      g[i,j]:=1;    end;  close(fin);  {считали граф}  DFS;                                {вызываем процедуру}  for i:=top downto 1 do    write(spisok[i],' ');         {выводим результат на экран} end.

Алгоритм Дейкстры

Представим себе карту автомобильных дорог Украины. Как найти кратчайший путь например из Днепропетровска в Ужгород? Можно, конечно, перебрать все возможные пути и выбрать минимальный из них. Но тогда получаются миллионы заведомо неверныз вариантов. Вот например зачем мне ехать из Днепра в Ужгород через Донецк, наматывая около шестисот лишних километров? Далее будет рассмотрен эффективный способ решения этой задачи.
Алгоритм Дейкстры решает задачу о кратчайших путях из одной вершины для взвешенного ориентированного графа G = (V,E) с исходной вершиной s, в котором веса всех ребер неотрицательны.
В процессе работы алгоритма поддерживается множетсво S, состоящее из вершин v, для которых расстояние от s до v уже известно. На очередном шаге алгоритм выбирает вершину u, не принадлежащую V и имеющую минимальное d[u] (где d[u] это расстояние от s до u). Далее производится т.н. релаксация всех ребер, выходящих из u. Это означает, что для каждого ребра ui если d[u ]+w(u,i)<d[i ] то d[i ]=d[u ]+w(u,i), где w(u,i) - это вес ребра ui. Все вершины, не принадлежащие S, хранятся в очереди Q

Алгоритм Дейкстры:

Цитата

АЛГ DIJKSTRA(G,s)   Для всех вершин v из V     нц       d[v]<=MAX       parent[v]<=NIL     кц   d[s]<=0   S<=пустое множество   Q<=V   Пока Q - не пустое множество     нц       u<=минимальное из Q       S<=S+{u}       Для всех вершин v, являющихся потомком u         нц           Если d[v]>d[u ]+w(u,v) то             не               d[v]<=d[u ]+w(u,v)               parent[v]<=u             ке         кц     кц КОН

Реализация на Паскале

Код

program dijkstra; var   G:array[1..100,1..100] of integer; {матрица, задающая граф}   Q,W:array[1..100]  of byte;        {очередь и массив весов}   i,j:word;                            s:word;   d:array[1..100] of word;           {массив расстояний: после завершения работы d[i] - расстояние от s до i}   p:array[1..100] of word;           {массив родителей}   f:text;   n:word;                            {колличество вершин}   nQ:word;   nW:word;   min,mI:word; begin   {Процесс считывания информации из текстового файла}   assign(f,'dijkstra.dat'); reset(f);   for i:=1 to 100 do    for j:=1 to 100 do      G[i,j]:=-1;   read(f,n); readln(f,s);   while not EOF(f) do    begin     read(f,i); read(f,j); readln(f,G[i,j]);    end;   close(f);   {Информация считана из файла}      for i:=1 to n do    begin     d[i]:=65535;     p[i]:=0;    end;   d[s]:=0;   for i:=1 to n do    Q[i]:=i;   nq:=n; nW:=0;      while nq<>0 do    begin      min:=65535;      for i:=1 to n do    {ищем вершину с минимальным d[i]}        if (Q[i]<>0) and (d[i]<min) then          begin           min:=d[i]; mI:=i;          end;      dec(nQ);                  Q[mI]:=0;      inc(nW); W[nW]:=mI;            for j:=1 TO n DO       if G[mi,j]<>-1 then         if d[j]>d[Mi]+G[Mi,j] then          begin           d[j]:=d[mi]+g[mi,j];           p[j]:=mi;          end;    end;      {вывод на экран}    for i:=1 to n do   writeln(d[i]); end.

Спасибо за информацию и перевод общего описания в родной Паскаль по учебе приходится изучать теорию графов и алгоритмы на графах, но описание всего этого дается в таком непонятном виде, что все желание заниматься этим пропадает...

Дали вот задание: написать процедуру, реализующую метод, отличающийся от поиска в ширину только тем, что вновь достигнутая вершина помещается не в очередь, а в стек ... с какой стороны подходить к нему? ...что будет на входе, и что должно оказаться на выходе ...не понятно...

Цитата

Дали вот задание: написать процедуру, реализующую метод, отличающийся от поиска в ширину только тем, что вновь достигнутая вершина помещается не в очередь, а в стек

так это и есть отличие поиска вглубину от поиска в ширину
очередь соответствует поиску в ширину, а стек - в глубину
отличие стека от очереди...
гы... вспомнил интересную иллюстрацию: автомат Калашникова преобразует стек в очередь:
магазин у автомата построен так: последний вставленный патрон находится сверху, он и будет взят первым
ствол построен принципиально иначе: та пуля, которая попала в его начало первой, первой и вылетит с другого конца

Буду мучиться ))) тока суть все равно не пойму... поиск в ширину или глубину... поиск чего? что там ищется? что будет найдено? и зачем это вообще с практической точки зрения )))

Цитата(Hidrag @ 26.4.2005, 15:54)

Буду мучиться ))) тока суть все равно не пойму... поиск в ширину или глубину... поиск чего? что там ищется? что будет найдено?  и зачем это вообще с практической точки зрения )))

вообще мне кажется, что лучше употреблять слово "обход" вместо "поиск"
на абстрактном уровне:
есть дерево (вообще-то можно и любой граф, но для простоты рассмотрения пусть будет дерево)
только задано оно не массивом узлов и ребер, а по-другому:
для каждого узла есть функция, которая "делает" его потомков (поручик, молчать!!! )
теперь перед нами стоит задача - найти узел, удовлетворяющий какому-нибудь критерию (к этой задаче сводится просто огромное количество самых разных проблем)
был бы это массив, мы бы просто прошлись по нему и нашли какой-нибудь узел
но способ задания другой (часто бывает, что такой массив бы просто не поместился в памяти), поэтому приходится начинать с первой вершины (конечно же, проверить, не она ли искомая), получить ее потомков, их потомков, и т.д.
можно сначала посмотреть на первую вершину, потом на ее прямых потомков, потом на их потомков (это - поиск в ширину)
можно по-другому: посмотреть на первую вершину, на первого ее потомка, на первого потомка его потомка, ..., добраться до конца, вернуться на уровень выше, посмотреть на второго и т.д. (это - поиск в глубину)
пример:
предположим, нам надо найти строку
только нам не сказали, что это за строка, а дали функцию, которая возвращает true или false для данной строки (например, взламываем программу полным перебором - метод жуткий, но ситуацию иллюстрирует хорошо
и еще нам известно, что искомая строка не длиннее 10 символов (это - отдельный момент, к нему вернемся позже)
надо перебрать все строки
есть два способа:
1. перебираем все строки длиной 1, потом длиной 2, ... , длиной 10 (в ширину)
2. перебираем все строки с первой буквой A, с первой буквой B, ... с первой буквой Z (в глубину)

если ограничение на длину строки не 10, а 3 (для наглядности), получим следующую последовательность:
1. в ширину: A,B,C,AA,AB,AC,BA,BB,BC,CA,CB,CC,AAA,AAB,AAC,ABA,ABB,ABC,не, мен даже при 3-х символах уже надоело
2. в глубину: A,AA,AAA,AAB,AAC,AB,ABA,ABB,ABC,AC,ACA,ACB,ACC,B,BA,BAA,...

вот и все объяснение
P.S.
ну и обещанный возврат к ограничению на длину строки
в общем случае это - ограничение на глубину дерева (маскимальную длину ветки), так вот оно не всегда есть
например, в Прологе, когда производится попытка доказательства новых утверждений на основе старых получается именно вот такой проход по дереву (в каждый момент мы можем вспомнить одну из нескольких базовых посылок, а значит, получается ветвление). Но есть одна проблема: доказательство в принципе может быть любой длины, т.е. ограничения на глубину дерева нет
в таких ситуациях поиск в глубину принципиально неприменим, поэтому там, насколько я припоминаю, используется поиск в ширину...

maxim1000
Круто! ))) если бы нам так это преподавали возможно это бы и не было таким сложным, а то дали сухую голую теорию, задания, и делайте что хотите...
Уже по дискретной математике зачет с экзаменом сдал по теории графов, а все равно врубиться не могу никак...
написать процедуру, реализующую метод, отличающийся от поиска в ширину только тем, что вновь достигнутая вершина помещается не в очередь, а в стек
... уже скоро во сне сниться будет (((

Модератор: давайте обсуждать алгоритмы в других темах. А здесь - только их реализация на Паскале!

Ребята, помогите с реализацией на Паскале какой-то конкретной задачи, с входными и выходными данными. Я не особо разбирабсь в програмировании, поэтому не понял, програма приведенная више, так ничего и не выполняет? Она то запускается, но ничего же не считает. Работает с голыми переменными?

Banderas! Еще раз прошу создавать отдельные топики для обсуждения алгоритмов

Цитата(Banderas @ 24.5.2005, 21:46)

поэтому не понял, програма приведенная више, так ничего и не выполняет

Она считывает информацию с текстового файла, решает задачу и выводит определенную информацию на екран. Ввод-вывод показаны как пример и их легко переписать на нужные тебе.
Например в приведенном мною алгоритме DFS ввод такой:

Код

assign(fin,paramstr(1)); reset(fin);       readln(fin,n);       while not EOF(fin) do         begin           read(fin,i); readln(fin,j);           g[i,j]:=1;         end;       close(fin);

Сначала из первой строки файла считываем количество вершин графа. Затем до конца файла в строках по два числа i и j что означает что есть ребро из i и j. Эта информация заносится в матрицу.

Это сообщение отредактировал(а) Fedor - 25.5.2005, 07:10

Спасибо огромное за столь полезную информацию, особенно порадовал Алгоритм Дейкстры 
А ещё, не могли бы вы рассказать мне, глупышке, как задавать исходные данные для графа?

Если представить граф в виде матрицы смежности то:

Ну а в виде списков смежных вершин просто считываешь указатель на запись....

--- что-то вроде этого....только с косяками =) (с таким врятли столкнешься, ....... тут понятно, что разумней будет воспользоваться деревом )

Это сообщение отредактировал(а) Dobermann - 5.5.2008, 22:50