Cod sursa(job #1339102)

Utilizator casianos1996Marc Casian Nicolae casianos1996 Data 10 februarie 2015 18:00:25
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.72 kb
program numarare;
var t:array[0..1,1..100000] of longint;
    n,m,s,i:longint;
    start,d,co:array[1..100000] of longint;
    f,g:text;
    viz:array[1..100000] of 0..1;
procedure citire;
var i,j,k,z:longint;
    begin
         assign(f,'bfs.in');
         reset(f);
         assign(g,'bfs'.out');
         rewrite(g);
         read(f,n,m,s);
         k:=0;
         for z:=1 to m do
             begin
                  read(f,i,j);
                  inc(k);
                  t[0,k]:=j;
                  t[1,k]:=start[i];
                  start[i]:=k;
             end;
    end;
procedure bf(nod:longint);
var p,st,sf:longint;
    begin
         st:=1;
         sf:=1;
         co[st]:=nod;
         viz[nod]:=1;
         d[nod]:=0;
         while st<=sf do
              begin
                      p:=start[co[st]];
                      while p<>0 do
                            begin
                                 if viz[t[0,p]]=0 then
                                       begin
                                             inc(sf);
                                             co[sf]:=t[0,p];
                                             viz[t[0,p]]:=1;
                                             d[t[0,p]]:=d[co[st]]+1;
                                       end;
                                 p:=t[1,p];
                            end;
                      inc(st);
              end;
    end;
begin
     citire;
     bf(s);
     for i:=1 to n do
          if i=s then
              write(g,0,' ')
          else
               if (i<>s) and (d[i]=0) then
                    write(g,-1,' ')
          else
               write(g,d[i],' ');
     close(f);
     close(g);
end.