Cod sursa(job #449268)

Utilizator streitferd_erikaStreitferd Erika streitferd_erika Data 6 mai 2010 01:43:29
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.76 kb
program bfs;
type Pelem=^elem;
        elem=record
             kov:pelem;
             i:longint;
           end;

var be,ki:text;
    readbuf,writebuf:array[1..10240] of byte;
    graf:array[1..100000] of pelem;
    v:array[1..100000] of longint;
    n,m,k:longint;
    l:array[1..100000] of longint;
    i,j:longint;

procedure olvas;
var c:pelem;
    x,y,q:longint;
begin
        for q:=1 to m do
          begin
            readln(be,x,y);
            if x<>y then
              if x=k then
                begin
                  v[y]:=1;
                  inc(j);
                  l[j]:=y;
                end
                   else
                 begin
                  c:=graf[x];
                  new(graf[x]);
                  graf[x]^.kov:=c;
                  graf[x]^.i:=y;
                 end;
           end;
end;

procedure kiir;
var i:longint;
begin
        for i:=1 to n do
          write(ki,v[i],' ');
end;

procedure megold;
var c:pelem;
begin
        while i<=j do
          begin
            c:=graf[l[i]];
            while c <> nil do
             begin
               if v[c^.i]=-1 then
                 begin
                   v[c^.i]:=v[l[i]]+1;
                   inc(j);
                   l[j]:=c^.i;
                 end;
               c:=c^.kov;
             end;
            inc(i);
          end;
end;

begin
        assign(be,'bfs.in');
        assign(ki,'bfs.out');
        settextbuf(be,readbuf);
        settextbuf(ki,writebuf);
        reset(be);
        rewrite(ki);
        read(be,n,m);
        for k:=1 to n do
          v[k]:=-1;
        readln(be,k);
        k:=0;
        v[k]:=0;
        i:=1;
        olvas;
        megold;
        kiir;
        close(ki);
end.