Cod sursa(job #1339435)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 10 februarie 2015 21:35:25
Problema BFS - Parcurgere in latime Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.15 kb
program mire;
var co,start:array[1..100000] of longint;
     viz:array[1..100000] of integer;
     n,m,s:longint;
     f,g:text;
     t:array[0..2,0..100001] of longint;
procedure citire;
var i,a,b,k,j:longint;
begin
  assign(f,'bfs.in'); reset(f);
  readln(f,n,m,s);
  k:=0;
  for i:=1 to m do
    begin
       readln(f,a,b);
       k:=k+1;
       t[0,k]:=b;
       t[1,k]:=start[a];
       start[a]:=k;
       //inc(k);
       //t[0,k]:=a;
       //t[1,k]:=start[b];
       //start[b]:=k;
    end;
    close(f);
end;
procedure bf;
var st,sf,pp,i,ii,j:longint;
begin
       // for i:=1 to n do
 //begin
  st:=1;
  sf:=1;
  co[st]:=s;
  viz[s]:=1;
  while st<=sf do
    begin
      pp:=start[co[st]];
      while pp<>0 do
        begin
          if viz[t[0,pp]]=0 then
          begin
           sf:=sf+1;
           co[sf]:=t[0,pp];
           viz[co[sf]]:=viz[co[st]]+1;
           //v[co[sf]]:=v[co[st]]+1;
          end;
         pp:=t[1,pp];
        end;
      st:=st+1;
    end;

      for j:=1 to n do
         write(g,viz[j]-1,' ');


end;
begin
citire;
 assign(g,'bfs.out'); rewrite(g);
 bf;
 close(g);
end.