Cod sursa(job #1757300)

Utilizator TolomeiuEusebiuTolomeiuEusebiuMarin TolomeiuEusebiu Data 14 septembrie 2016 20:15:30
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.78 kb
program nume;
type vector=array [1..1000]of longint;
var coada,start,viz:vector;
    t:array [0..2,1..1000] of longint;
    f,g:text;
    inceput,final,c,n,m,i,l,s,j,k,p:longint;
begin
    assign(f,'bfs.in');
    reset(f);
    assign(g,'bfs.out');
    rewrite(g);
    readln(f,n,m,s);
   { setlength(coada,m+1);
    setlength(start,n+1);
    setlength(viz,n+1);
    setlength(t,m+1,m+1);}
    k:=0;
    for l:=1 to m do
       begin
           readln(f,i,j);
           k:=k+1;
           t[0,k]:=j;
           t[1,k]:=start[i];
           start[i]:=k;
           {k:=k+1;
           t[0,k]:=i;
           t[1,k]:=start[j];
           start[j]:=k;}
       end;
   { for i:=1 to n do
      begin
           p:=start[i];
           write(i,'---->');
           while p<>0 do
             begin
                 write(t[0,p],' ');
                 p:=t[1,p];
             end;
             writeln;
      end; }
      inceput:=1;
      final:=1;
      coada[inceput]:=s;
      viz[s]:=0;
      c:=0;
      while inceput<=final do
         begin
             p:=start[coada[inceput]];
             c:=c+1;
             while p<>0 do
                begin
                   if viz[t[0,p]]=0 then
                      begin
                          final:=final+1;
                          coada[final]:=t[0,p];
                          viz[t[0,p]]:=c;
                      end;
                          p:=t[1,p];
                end;
                inceput:=inceput+1;
         end;
        for i:=1 to n do
          begin
               if viz[i]=0 then
                           viz[i]:=-1;
               if (i=s)and(viz[s]=1) then
                           viz[s]:=0;
               write(g,viz[i],' ');
          end;
close(f);
close(g);
end.