IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Поиск циклов в неориентированном графе
legend-muay
сообщение 18.10.2009 20:26
Сообщение #1





Группа: Пользователи
Сообщений: 6
Пол: Мужской

Репутация: -  0  +


Всем доброе время суток. Нужна помощь алгоритмом или кодом поиска циклов в неориентированном графе. Граф задан матрицей смежности, и списком ребер. В общем есть программа для определения числа связности графа и компонент связности, а вот как этот алгоритм применить к поиску циклов не знаю((
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 2)
legend-muay
сообщение 20.10.2009 21:39
Сообщение #2





Группа: Пользователи
Сообщений: 6
Пол: Мужской

Репутация: -  0  +


Вот код для определения числа связности. В задании написанно, что этот же алгоритм применяется и для определения циклов. В общем у меня не получилось переделать его под циклы((

{ Определение числа связности }
//a-матрица смежности
//mark-массив с метками для вершин, если вершина пройдена тогда 1, иначе 0
//count_rec-кол-во вершин в связном компоненте
//count_c-число связности
procedure step(c1,v:byte);
var jin:byte;
begin
 mark[v]:=1;
 for jin:=1 to n do
  if (mark[jin]=0) and (a[v,jin]<>0) then
   begin
    inc(count_rec);
    lbl[c1,count_rec]:=jin;
    step(c1,jin);
   end;
end;

procedure svyaznost(nin:byte;var countC:byte);
var iin:byte;
begin
 for iin:=1 to nin do mark[iin]:=0;
 countC:=0;
 for iin:=1 to nin do
  if mark[iin]=0 then
   begin
    count_rec:=0;
    inc(countC);
    inc(count_rec);
    lbl[countC,count_rec]:=iin;
    step(countC,iin);
    lbl[countC,0]:=count_rec;
   end;
end;
{ End 
      lbl-связные компоненты}



Сообщение отредактировано: legend-muay - 20.10.2009 21:43
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
legend-muay
сообщение 23.10.2009 17:40
Сообщение #3





Группа: Пользователи
Сообщений: 6
Пол: Мужской

Репутация: -  0  +


Нашел в инете код поиска циклов в неориентированном графе, может кому-то еще понадобится

const
 n0=5; {vershini}
var
 m:integer; {rebra}
 n:byte; {vershiny}
 graf:array[1..n0,1..n0] of byte;{матрица смежности}
 DOP:array[1..n0] of boolean;
 X:array[1..n0] of byte;{здесь будут храниться вершины цикла}
 i,j,k:byte;

procedure cycle(i:byte);
var u,j:byte;
begin
  for u:=1 to n do
    if graf[X[i-1],u]=1 then
      begin
        if (u=k) AND (i>=4)  then {nashli cikl}
          begin
            for j:=1 to i-1 do
              write(X[j],' ');
            writeln(k);
          end
        else if DOP[u] then
             begin
               X[i]:=u; DOP[u]:=false;
               cycle(i+1);
               {vozvrat}
               X[i]:=0;
               DOP[u]:=true;
             end;
      end;
end;

BEGIN {main}
  for i:=1 to n0 do
  for j:=1 to n0 do
    graf[i,j]:=0;

  for i:=1 to n0 do
    begin
      DOP[i]:=true;
      X[i]:=0;
    end; 

  Write('Vvedite kolvo vershin n= '); readln(n);
  Write('Vvedite kolvo reber m= '); readln(m);
  for i:=1 to m do
  begin
    Write('Vvedit cherez probil vershini ',i,' rebra: '); Readln(j,k);
    graf[j,k]:=1;
    graf[k,j]:=1;
  end; 

 Write('Vvedite nachalo cikla k='); readln(k);
 X[1]:=k; DOP[k]:=false;
 cycle(2);{zapolnjaem X dalshe}
 readln;
END.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 29.07.2025 10:05
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"