Cod sursa(job #1880082)

Utilizator alexandrasirbuAlexandra alexandrasirbu Data 15 februarie 2017 14:24:16
Problema BFS - Parcurgere in latime Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.73 kb
type lista=^element;
     element=record
         i:int64;
         a:lista;
             end;

var ultim,c,p:lista;
    l:array[1..1000001] of int64;
    v:array[1..1000001] of lista;
    viz: array[1..1000001] of boolean;
    i,d,n,m,s,a,b:int64;
    fi, fo: text;

procedure bfs(s, d:int64);

var w:lista;
begin
 p:=v[s];
 while p<>nil do
 begin
  if viz[p^.i]=false then begin
                                     l[p^.i]:=d;
                                     new(w);
                                     w^.i:=p^.i;
                                     w^.a:=nil;
                                     ultim^.a:=w;
                                     ultim:=w;
                                     viz[p^.i]:=true;
                                    end;
  p:=p^.a;
 end;
 if c<>nil then begin
                 c:=c^.a;
                 if c<>nil then bfs(c^.i,l[c^.i]+1);
                 end;
end;

begin
   assign(fi,'bfs.in'); reset(fi);
   read(fi,n,m,s); i:=1;
   //for i:=1 to n do begin
   while i<=n do begin
                     v[i]:=nil;
                     l[i]:=-1;
                     viz[i]:=false;
                     inc(i);
                    end;
   l[s]:=0;i:=1;
   //for i:=1 to m do begin
   while i<=m do begin
                     read(fi, a,b);
                     new(p);
                     p^.i:=b;
                     p^.a:=v[a];
                     v[a]:=p;
                     inc(i);
                    end;

   close(fi);

   new(p); p^.i:=s; p^.a:=nil; c:=p; ultim:=p;
   //d:=1;
   bfs(s, 1);

   assign(fo,'bfs.out'); rewrite(fo); i:=1;
  // for i:=1 to n do
  while i<=n do begin
         write(fo, l[i],' '); inc(i); end;
   close(fo);
end.