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

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

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

 
 Ответить  Открыть новую тему 
> Обход в ширину
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Вот так работает:
Procedure BFS(const a: graph; n: integer);
var go: array[1..max] of boolean;
i: integer;

Procedure BFS2;
var
og: array[1..max] of integer;
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 max do
go[i] := true;
BFS2;
writeln;
end;


Результат:
Matrix of weight:
0 1 ** 1 ** **
1 0 1 ** ** **
** 1 0 1 1 **
1 ** 1 0 1 1
** ** 1 1 0 1
** ** ** 1 1 0

Dlya kakoy vershini provesti DFS: 2
DFS - 2 - 1 - 2 - 3 - 5 - 6 - 5 - 3 - 2
Dlya kakoy vershini provesti BFS: 2
2 1 3 4 5 6
 К началу страницы 
+ Ответить 

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

 





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