Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Object Pascal: кроссплатформенные технологии > Задача на графы.

Автор: Joil 16.2.2008, 20:17

Какая то адская задача smile

:
С помощью метода поиска в глубину найдите стягивающее дерево для произвольного связного неориентированного графа, заданного списками инцидентности.
--------
Люди, пожалуйста помогите. Может, если у кого есть ссылки по теме, или задачи похожие, или может примерно алгоритм решения хоть напишите.
Буду рад любой помощи.
Заранее спасибо.

Автор: Wowa 17.2.2008, 12:12

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

А вообще, есть же алгоритм глубинного поиска. Чем он не подходит?

Автор: Dobermann 18.2.2008, 16:00

Код


program DearchInDepth;
const lim=10; uses crt;
type Mtr=array[1..lim,1..lim]of byte;
     lab=array[1..lim]of boolean; 
var A:Mtr; new:lab;n,i:byte; 
Rebra:array[1..2,1..lim]of byte;
cnt,tek,pred:byte;
procedure Vvod; var i,j:byte;
begin write('n=');
readln(n); for i:=1 to n do 
begin
write(i,'>');read(j); 
while j>0 do 
begin 
a[i,j]:=1; read(j)
end end end;
procedure PoiskGlub(v:byte);
var j:byte; 
begin 
new[v]:=false;
write(v:3); for j:=1 to n do if(a[v,j]>0)
and new[j] then 
begin 
PoiskGlub(j); inc(cut);
rebra[1,cnt]:=v; rebra[2,cnt]:=j 
end end;
begin 
clrscr; fillchar(new, sizeof(new),true);
fillchar(a,sizeof(a),0); vvod; cnt:=0; 
for i:=1 to n do if new[i] then PoiskGlub(i);
writeln;writeln('Rebra:'); for i:=1 to cnt do
writeln(rebra[1,i],' ',rebra[2,i]); readln
end.

Вот тебе поиск в глубину (пр.неор. граф).

Автор: Joil 20.2.2008, 07:30

Dobermann, Very Great Thanks, незнаю что бы без тебя делал. smile