Cod sursa(job #1757324)

Utilizator TolomeiuEusebiuTolomeiuEusebiuMarin TolomeiuEusebiu Data 14 septembrie 2016 20:44:27
Problema BFS - Parcurgere in latime Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.72 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]];
             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;
         viz[s]:=0;
        for i:=1 to n do
          begin
               if (viz[i]=0)and(i<>s) then
                           viz[i]:=-1;
               write(g,viz[i],' ');
          end;
close(f);
close(g);
end.