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

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

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

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Поиск в ширину в графе
сообщение
Сообщение #1


Новичок
*

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

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


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

я не знаю с чего начать, посмотрел в "FAQ" но не смог разобраться
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Вот тут глянь: http://alex.fanshop.ru/articles/graphs.shtml
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


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

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


Эскизы прикрепленных изображений
Прикрепленное изображение
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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


Подскажите, пожалуйста, а то у меня все застопорилось, не могу определиться в алгоритме просмотра графа в ширину
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Вот принцип поиска в ширину:
Цитата(http://alex.fanshop.ru/articles/graphs.shtml)
Подобно тому как, согласно принципу Гюйгенса, каждая точка волнового фронта является источником вторичной волны, мы, отправляясь из заданной вершины V, посещаем все смежные с ней вершины (т.е. вершины, в которые ведут стрелки из V). Каждая посещенная вершина становится источником новой волны и т. д.

По-моему, порядок обхода "269, 525, 327, 12, 679" не противоречит этому принципу...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

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

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


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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Расшифровка - дальше в тексте программы:
{указатель на начало списка связей v-й вершины}
m[v]:=lst[v];
, откуда становится ясно, что lst[ i ] содержит список связей вершины i
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

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

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


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

Исходный код
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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






А что, Mark/Release уже отменили? ;)
Var
p_start: Pointer;
...
WriteLn(MemAvail);
Mark(p_start); { перед созданием графа }
... { работа с графом }
Release(p_start); { вернемся к состоянию, которое было до Mark }
WriteLn(MemAvail);
...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

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

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


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

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

Заранее благодарю за помощь.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






Цитата(Aleks @ 15.09.05 11:29)
что бы я делал без тебя

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

Цитата(Aleks @ 15.09.05 11:29)
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;


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


Новичок
*

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

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


Как организовать освобождение памяти не с помощью процедур 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;

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


Профи
****

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

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


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


--------------------
Никогда не жадничай. Свои проблемы с любовью дари людям!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Aleks, у тебя же создаются элементы m[]? Так почему бы не попробовать:
procedure  delet;
var
h: integer;
begin
for h:=1 to max do
if m[h] <> nil then dispose(m[h]);
end;
? А вот lst[] тут ни при чем, а ведь удалять ты пытался именно их !!!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

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

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


Результат работы программы остается 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






А ты проходил по программе в пошаговом режиме? У тебя же некоторые значения 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) байт... rolleyes.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Новичок
*

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

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


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


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

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

т.е. и получается, что 1 вершина (768) соединяется с 172 и 475
и для 1 вершины создается 2 элемента в памяти
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Гость






Цитата
и для 1 вершины создается 2 элемента в памяти
Угу... Только вот компилятор тебя не понял, и удаляет первую вершину... А ты должен ему объяснить, что этого делать не надо, и что надо связать новую вершину с предыдущей...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Новичок
*

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

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


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

Код
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;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Гость






О !!! Меня посетила простая до невозможности идея smile.gif Берешь процедуру 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;

Попробуй... По-моему, должно сработать...
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 4.10.2022 16:33
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name