Поиск в ширину в графе Опции

[Aleks]

Помогите решить задачу
Напишите и используйте в программе процедуру поиска в ширину в графе, заданном списками инцидентности. Выведите на экран номера всех вершин в порядке очередности просмотра.

я не знаю с чего начать, посмотрел в "FAQ" но не смог разобраться

[volvo]

Вот тут глянь: http://alex.fanshop.ru/articles/graphs.shtml

[Aleks]

я написал код для создания графа
в реезультате...
задаем количество вершин графа – 5
ребра между ними формируются случайным образом.
Список инцидентности созданного графа:
269-> 327-§
679-> 327-12-§
12-> 327-269-§
327-> 525-§
525-> 12-269-§
КОЛ-ВО РЕБЕР СОЗДАННОГО ГРАФА: 8
Примечание: символ «§» соответствует концу списка (nil).

я правильно понимаю алгоритм поиска в ширину в графе (см.рисунок)
порядок очередности просмотра будет: 269, 12, 327, 525, 679

[Guest]

может ли быть, порядок очередности просмотра графа: 269, 525, 327, 12, 679 (см.рис выше)


Подскажите, пожалуйста, а то у меня все застопорилось, не могу определиться в алгоритме просмотра графа в ширину

[volvo]

Вот принцип поиска в ширину:

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

По-моему, порядок обхода "269, 525, 327, 12, 679" не противоречит этому принципу...

[Aleks]

volvo спасибо за ссылку. Программа работает.

не мог бы ты мне объяснить назначение переменной lst, m (это код из твоей ссылке http://alex.fanshop.ru/articles/graphs.shtml), а то я переделал немного код (но не совсем понимаю их назначение: m[i] –> содержит для каждой вершины в памяти данные)
и еще вопрос как освободить память, не могу сообразить

Исходный код

const
maxraz=400;
type index=^list;
list= record
inf: word;
next: index;
end;
connection=array[1..maxraz] of index;
var
lst,m: connection;
.....

***Процедура создания графа в динамической памяти***}
procedure Make_Graph(mgsi: boolean);
label Er;
var
n: index;
i,j: word;
kolvo: longint;
spro: boolean;
begin
randomize;
for i:=1 to raz do begin
ver[i]:=random(1000);
end;
kolvo:=0;
for i:=1 to raz do begin
lst[i]:=nil;
for j:=1 to raz do begin
spro:=true;
if j=raz then goto Er;
if j=i then inc(j);
n:=nil;
n:=lst[j];
if lst[j]<>nil then
repeat
if n^.inf=ver[i] then spro:=false;
n:=n^.next;
until (n=nil) or (not(spro));
if (round(random)=1) and spro then
begin
new(m[i]); inc(kolvo);
m[i]^.inf:=ver[j];
m[i]^.next:=lst[i];
lst[i]:=m[i];
end;
Er:
end;
end;
writeln;
if mgsi then {ВЫВОД СВЯЗЕЙ ВЕРШИН}
for i:=1 to raz do {}
begin {}
write(ver[i],' '); {}
m[i]:=lst[i]; {}
if m[i]<>nil then {}
repeat {}
write(m[i]^.inf,'═'); {}
m[i]:=m[i]^.next; {}
until m[i]=nil; {}
writeln(' '); writeln; {}
end; {}
writeln('КОЛ-ВО РЕБЕР СОЗДАННОГО ГРАФА: ',kolvo);
end;
........

Сообщение отредактировано: volvo - 15.09.2005 15:14

[volvo]

Расшифровка - дальше в тексте программы:

{указатель на начало списка связей v-й вершины}
m[v]:=lst[v];

, откуда становится ясно, что lst[ i ] содержит список связей вершины i

[Aleks]

как освободить память, не могу сообразить

Исходный код

uses crt;
const
max=400;
type
index= ^list;
list= record
inf: integer;
next: index;
end;
connection= array[1..max] of index;

var
lst, m: connection;
ver: array[1..max] of integer;
ocher: array[1..max+1] of integer;
key, z, raz: integer;
find_v: boolean;

procedure DP_Graph;
var
n: index;
i, j: integer;
kolvo: longint;
spro: boolean;

procedure add;
begin
new(m[i]);
m[i]^.inf:= ver[j];
m[i]^.next:= lst[i];
lst[i]:= m[i];
inc(kolvo);
end;

begin
randomize;
for i:=1 to raz do ver[i]:= random(1000);
kolvo:= 0;
for i:=1 to raz do
begin
lst[i]:= nil;
for j:=1 to raz do
begin
spro:= true;
if j<> raz then
begin
if j=i then inc(j);
n:= nil;
n:= lst[j];
if lst[j]<>nil then
repeat
if n^.inf=ver[i] then spro:= false;
n:= n^.next;
until (n=nil) or (not(spro));
if (round(random)=1) and spro then add;
end;
end;
end;
writeln('Kol-vo reber Grapha: ',kolvo);
writeln;
end;

procedure print_ver;
var
i: integer;
begin
for i:=1 to raz do
begin
write(ver[i],'');
m[i]:= lst[i];
if m[i]<>nil then
repeat
write(m[i]^.inf,'=');
m[i]:= m[i]^.next;
until m[i]= nil;
writeln('');
end;
end;

procedure find_Graph(find_v: boolean; key: integer);
var
q: integer;
t, ov, oc, i: integer;
pr: boolean;

procedure p_ver;
var
j, i: integer;
pr: boolean;
begin
for i:=2 to raz do
begin
m[i]:= lst[i];
repeat
pr:= false;
q:= m[i]^.inf;
m[i]:= m[i]^.next;
if ocher[oc]=q then
begin
for j:=1 to ov do if ocher[j]=ver[i] then pr:= true;
if pr=false then
begin
ocher[ov]:= ver[i];
inc(ov);
end;
end;
until m[i]=nil;
end;
i:= 2;
end;

begin
ov:= 1; oc:= 1;
ocher[oc]:= ver[oc];
m[oc]:= lst[oc];
while m[oc]<>nil do
begin
q:= m[oc]^.inf;
m[oc]:= m[oc]^.next;
inc(ov);
ocher[ov]:= q;
end;
inc(ov);
p_ver;
if ocher[oc]=key then find_v:= true;
while oc<raz do
begin
inc(oc);
for i:=1 to raz do
begin
p_ver;
if ocher[oc]=ver[i] then
begin
m[i]:= lst[i];
while m[i]<> nil do
begin
pr:= false;
q:= m[i]^.inf;
m[i]:= m[i]^.next;
for t:=1 to ov do if ocher[t]=q then pr:= true;
if pr=false then
begin
ocher[ov]:= q;
inc(ov);
end;
end;
end;
end;
if ocher[oc]=key then find_v:= true;
end;
if not(find_v) then writeln('К сожалению такой вершины нет...')
else writeln('Вершина графа ',key,' найдена!');
end;

procedure delet;
begin

end;

begin
repeat
clrscr;
writeln('--', memavail);
write('Kol-vo vershin Grapha (ne menee 4) : ');
readln(raz);
until raz>3;
DP_Graph;
print_ver;
write('Vvedite iskom vershinu: ');
readln(key);
find_v:= false;
find_Graph(find_v,key);
for z:=1 to raz do write(ocher[z],' - ');
writeln;
delet;
writeln;
writeln('--', memavail);
readln;
end.

[volvo]

А что, Mark/Release уже отменили? ;)

Var
  p_start: Pointer;
...
WriteLn(MemAvail);
Mark(p_start); { перед созданием графа }
... { работа с графом }
Release(p_start); { вернемся к состоянию, которое было до Mark }
WriteLn(MemAvail);
...

[Aleks]

Спасибо volvo, что бы я делал без тебя

volvo не затруднит тебя дать заключение по этой проге
где есть огрехи, которые следовало бы исправить.

Заранее благодарю за помощь.

[volvo]

что бы я делал без тебя

:D Делал бы сам ...

volvo не затруднит тебя дать заключение по этой проге где есть огрехи, которые следовало бы исправить.

Огрех или не огрех, но такие вещи не приветствуются, потому что могут привести к нежелательным результатам (процедура DP_Graph)...

for j:=1 to raz do begin
  spro:= true;
  if j<> raz then begin
    if j=i then inc(j); { <--- Изменение параметра цикла в самом цикле }
    n:= nil; n:= lst[j];
    if lst[j]<>nil then
    repeat
      if n^.inf=ver[i] then spro:= false; n:= n^.next;
    until (n=nil) or (not(spro));
    if (round(random)=1) and spro then add;
  end;
end;

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

[Aleks]

Как организовать освобождение памяти не с помощью процедур Mark и Release, а последовательным удалением элементов динамической структуры с последующим освобождением памяти с помощью процедуры Dispose.

я попробовал сам, но некоторые элементы все равно остаются в памяти

procedure  delet;
var
  h: integer;
begin
  for h:=1 to raz do
  begin
    m[h]:=lst[h];
    while m[h]<> nil do
    begin
      dispose(m[h]);
      m[h]:= nil;
    end;
  end;
end;

[hiv]

Вначале созавай динамические переменные с помощью New, а только потом уничтожай с помощью Dispose

[volvo]

Aleks, у тебя же создаются элементы m[]? Так почему бы не попробовать:

procedure  delet;
var
  h: integer;
begin
  for h:=1 to max do
    if m[h] <> nil then dispose(m[h]);
end;

? А вот lst[] тут ни при чем, а ведь удалять ты пытался именно их !!!

[Aleks]

Результат работы программы остается 64 б
--526432
Kol-vo vershin Grapha (ne menee 4 i ne bolee 100) : 5
Kol-vo reber Grapha: 8

768->172=475=§
475->172=§
409->475=§
172->201=409=§
201->475=768=§

Vvedite iskom vershinu: 2
Vershini 2 net...
Nomera vershin v poryadke prosmotra Grapha
768 - 172 - 475 - 201 - 409 -

--526368

Сообщение отредактировано: Aleks - 4.10.2005 15:08

[volvo]

А ты проходил по программе в пошаговом режиме? У тебя же некоторые значения m[i] перезаписываются новыми, при этом старые, естественно, безнадежно теряются... Попробуй прогони вот такую процедуру Add:

procedure add;
begin
  WriteLn('current i = ', i);

  new(m[i]);
  m[i]^.inf:= ver[j];
  m[i]^.next:= lst[i];
  lst[i]:= m[i];
  inc(kolvo);
end;

Как только увидишь повторяющиеся значения - потерял SizeOf(list) байт...

[Aleks]

А ты проходил по программе в пошаговом режиме? У тебя же некоторые значения m[i] перезаписываются новыми, при этом старые, естественно, безнадежно теряются...

может я ошибаюсь, но для m[i] вершины указываются связи с другими вершинами (ребра)

768->172=475=§
475->172=§
409->475=§
172->201=409=§
201->475=768=§

т.е. и получается, что 1 вершина (768) соединяется с 172 и 475
и для 1 вершины создается 2 элемента в памяти

[volvo]

и для 1 вершины создается 2 элемента в памяти

Угу... Только вот компилятор тебя не понял, и удаляет первую вершину... А ты должен ему объяснить, что этого делать не надо, и что надо связать новую вершину с предыдущей...

[Aleks]

а как процедура выводит связи с другими вершинами? откуда она их берет?

Код

procedure print_ver;
var
i: integer;
begin
{вывод i вершины и ее смежные вершины}
 for i:=1 to raz do
 begin
   write(ver[i],'->');
   m[i]:= lst[i];
   if m[i]<>nil then
   repeat
      write(m[i]^.inf,'=');
      m[i]:= m[i]^.next;
   until m[i]= nil;
   writeln('$');
 end;
end;

[volvo]

О !!! Меня посетила простая до невозможности идея Берешь процедуру Print_Ver, только вместо распечатки всех вершин производишь их удаление !!!

procedure delet;
var
  i: integer;
  T: index;
begin
  for i:=1 to raz do begin
    m[i]:= lst[i];
    if m[i]<>nil then
      repeat
        T := m[i];
        m[i]:= m[i]^.next;
        Dispose(T);
      until m[i]= nil;
  end;
end;

Попробуй... По-моему, должно сработать...