Cod sursa(job #612899)

Utilizator alexa_myparadiseAlexutzaaa alexa_myparadise Data 12 septembrie 2011 20:15:38
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.99 kb
program breadth_first;
const MAX_N=1001;
type plista=^lista;
     lista=record
     nod:integer;
     urm:plista;
     end;
var g:array[0..max_n] of plista;
    t,d,c:array[0..max_n] of integer;
    n,m,i,timp,x,y:integer;
    u:array[0..max_n] of byte;
    f:text;
procedure creare(i,j:integer);
var p:plista;
begin
new(p);
p^.nod:=j;
p^.urm:=g[i];
g[i]:=p;
end;
procedure bf(start:integer);
var p:plista;
   nod,st,dr:integer;
begin
fillchar(u,sizeof(u),0);
st:=1;
dr:=1;
c[st]:=start;
u[start]:=1;
d[start]:=0;
while (st<=dr) do
begin
  nod:=c[st];
  write(nod,' ');
  p:=g[nod];
  while (p<>nil) do
  begin
  if (u[p^.nod]=0) then
  begin
   inc(dr);
   c[dr]:=p^.nod;
   d[p^.nod]:=d[nod]+1;
   u[c[dr]]:=1;
   t[p^.nod]:=nod;
  end;
  p:=p^.urm;
 end;
 inc(st);
end;
end;
begin
assign(f,'graf.in');
reset(f);
readln(f,n,m);
for i:=1 to m do
 begin
  readln(f,x,y);
  creare(x,y);
  creare(y,x);
 end;
BF(2);
readln;
close(f);
end.