Cod sursa(job #1879627)

Utilizator alexandrasirbuAlexandra alexandrasirbu Data 15 februarie 2017 02:06:41
Problema BFS - Parcurgere in latime Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.45 kb
type lista=^element;
     element=record
         i:longint;
         a:lista;
             end;

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

procedure bfs(s,d:longint);

var w:lista;
begin
 p:=v[s];
 while p<>nil do
 begin
  if (l[p^.i]=-1)or(l[p^.i]>d) then begin
                                     l[p^.i]:=d;
                                     new(w);
                                     w^.i:=p^.i;
                                     w^.a:=nil;
                                     ultim^.a:=w;
                                     ultim:=w;
                                    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);
   readln(fi,n,m,s);
   for i:=1 to n do begin
                     v[i]:=nil;
                     l[i]:=-1;
                    end;
   l[s]:=0;
   for i:=1 to m do begin
                     readln(fi, a,b);
                     new(p);
                     p^.i:=b;
                     p^.a:=v[a];
                     v[a]:=p;
                    end;

   close(fi);

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

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