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

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

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

> Обход в ширину
Bo2nik
сообщение 4.06.2008 15:55
Сообщение #1


Новичок
*

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

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


Проблема с процедурой BFS(обход в ширину), не получается вывести нормальный путь или процедура корявая. Смотрел в FAQ - не помогло. Граф задан матрицой смежности. Вводится вершина из которой начинается обход.

Содержимое файла:
6
0 1 0 1 0 0
1 0 1 0 0 0
0 1 0 1 1 0
1 0 1 0 1 1
0 0 1 1 0 1
0 0 0 1 1 0

Например ввожу n=2:
DFS 2 - 1 - 4 - 3 - 5 - 6 - 5 - 3 - 4 - 1 - 2
BFS 2 - 1


Program workgraph;
uses crt;
const max=30;
max2=10000;

type graph = array [1..max,1..max] of integer;

var a,ras: graph;
size,n,j,i: integer;

Procedure ReadFile;
var i,j: integer;
f: text;
begin
assign(f,'D:\floyd2.txt');
reset(f);
readln(f,size);
for i:=1 to size do
for j:=1 to size do
begin
read(f,ras[i,j]);
if (ras[i,j]=0) and (i<>j) then
ras[i,j]:=max2;
end;
close(f);
end;

Procedure Print(a: graph);
var i,j: integer;
begin
for i:=1 to size do
begin
for j:=1 to size do
if a[i,j]=max2 then
write(' **')
else
write(a[i,j]:3);
writeln;
end;
end;

Procedure DFS(a: graph; n: integer);
var go: array[1..max] of boolean;
j: integer;

Procedure DFS2(n: integer);
var i :integer;
begin
write (' - ',n);
go[n]:=false;
for i:=1 to size do
if (go[i]) and (a[n,i]<>max2) and (i<>n) then
begin
DFS2(i);
write (' - ',n);
end;
end;

begin
for j:=1 to n do
go[j]:=true;
write ('DFS');
DFS2(n);
writeln;
end;

Procedure BFS(a: graph; n: integer);
var go: array[1..max] of boolean;
i: integer;

Procedure BFS2(n: integer);
var og: array[1..max] of 0..max;
u1,u2: integer;
j: integer;
begin
FillChar(og,sizeof(og),0);
u2:=0; u1:=1;
og[u1]:=n;
go[n]:=false;
while u2<u1 do
begin
inc(u2);
n:=og[u2];
write(n:2);
for j:=1 to size do
if (a[n,j]<>max2) and (go[j]) then
begin
inc(u1);
og[u1]:=j;
go[j]:=false;
end;
end;
end;

begin
for i:=1 to n do
go[i]:=true;
BFS2(n);
writeln;
end;

begin
clrscr;
ReadFile;
writeln('Matrix of weight: ');
Print(ras);
writeln;
write('Dlya kakoy vershini provesti DFS: ');
readln(n);
DFS(ras,n);
write('Dlya kakoy vershini provesti BFS: ');
readln(n);
BFS(ras,n);
readln;
end.



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

Сообщений в этой теме


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

 



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