Cod sursa(job #516463)

Utilizator FLORINSTELISTUOprea Valeriu-Florin FLORINSTELISTU Data 24 decembrie 2010 12:02:09
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.22 kb
program dfp;
type nod=^lista;
     lista=record
       info:longint;
       urm:nod;
       end;
var v:array[1..100000]of nod; f,g:text;n,m,s,i:longint;
    viz:array[1..100000]of 0..1;
    c:array[1..100000]of longint;
procedure add(x,y:longint);
var p:nod;
begin
    new(p);
    p^.info:=y;
    p^.urm:=v[x];
    v[x]:=p;
    end;
procedure citire;
var i,x,y:longint;
begin
     assign(f,'bfs.in');reset(f);
     assign(g,'bfs.out');rewrite(g);
       readln(f,n,m,s);
        for i:=1 to m do begin
         readln(f,x,y);
          add(x,y);
           end;
          end;
procedure bf(s:longint);
var z,p,u:longint;a:nod;
begin
     p:=1;u:=1;c[p]:=s;
         while p<=u do begin
          z:=c[p];
          a:=v[z];
           while a<>nil do begin
            if (viz[a^.info]=0 )and(a^.info<>s)and(a^.info<>z) then begin
            u:=u+1;
            c[u]:=a^.info;
            viz[a^.info]:=viz[z]+1;
             end;
            a:=a^.urm;  end;
            p:=p+1;
         end;
     end;
begin
    citire;
    bf(s);
   for i:=1 to n do
      if (viz[i]=0)and(i<>s) then write(g,-1,' ')
                             else write(g,viz[i],' ');
     close(f);close(g);
     end.