Cod sursa(job #1757354)

Utilizator TolomeiuEusebiuTolomeiuEusebiuMarin TolomeiuEusebiu Data 14 septembrie 2016 21:25:54
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.61 kb
program nume;
type vector=array of integer;
var coada,start,viz:vector;
    t:array of array of integer;
    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,n+1);
    setlength(start,n+1);
    setlength(viz,n+1);
    setlength(t,2,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]:=1;
      c:=0;
      while inceput<=final do
         begin
             p:=start[coada[inceput]];
             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]]:=viz[coada[inceput]]+1;
                      end;
                          p:=t[1,p];
                end;
                inceput:=inceput+1;
         end;
        for i:=1 to n do
          begin
               write(g,viz[i]-1,' ');
          end;
close(f);
close(g);
end.