Cod sursa(job #413600)

Utilizator zseeZabolai Zsolt zsee Data 8 martie 2010 20:12:59
Problema BFS - Parcurgere in latime Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.27 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;

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

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

procedure megold;
var i,j:longint;
    l:array[1..100000] of longint;
    c:pelem;
begin
 j:=1;
 l[1]:=k;
 v[k]:=0;
 i:=1;
 while i<=j do
   begin
     c:=graf[l[i]];
     while c <> nil do
      begin
       if v[c^.i] = -1 then
           begin
            v[c^.i]:=i;
            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);
 olvas;
 megold;
 kiir;
 close(ki);
end.