Cod sursa(job #1359955)

Utilizator batman1234Jugariu Mihai batman1234 Data 25 februarie 2015 10:16:22
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.94 kb
{Jugariu Mihai}
{BFS}
type adresa=^nod;
     nod=record
      nr:longint;
      urm:adresa;
     end;
var a:array[1..100000]of adresa;
    viz,b:array[1..100000]of longint;
    i,j,k,l,m,n,x,y:longint;
    p:adresa;
    f,g:text;

begin;
assign(f,'bfs.in');
reset(f);
assign(g,'bfs.out');
rewrite(g);
read(f,n,m,k);
for i:=1 to n do a[i]:=nil;
for i:=1 to m do
 begin;
  read(f,x,y);
  if a[x]=nil then
   begin;
    new(a[x]);
    a[x]^.nr:=y;
    a[x]^.urm:=nil
   end
              else
   begin;
    new(p);
    p^.nr:=y;
    p^.urm:=a[x];
    a[x]:=p;
   end;
 end;
for i:=1 to n do viz[i]:=-1;
b[1]:=k;
i:=0;l:=1;
viz[k]:=0;
repeat
 inc(i);
 p:=a[b[i]];
 x:=b[i];
 if p<>nil then
 repeat
  if viz[p^.nr]=-1 then
   begin;
    inc(l);
    b[l]:=p^.nr;
    viz[p^.nr]:=viz[x]+1;
   end;
  p:=p^.urm;
 until(p=nil);
until(i=l)or(l=m);
for i:=1 to n do write(g,viz[i],' ');
close(f);
close(g);
end.