Cod sursa(job #271359)

Utilizator philipPhilip philip Data 5 martie 2009 10:41:33
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.16 kb
type pnod=^nod;
     nod=record
       inf:longint;
       adr:pnod;
     end;

var f,g:text;
    n,m,i,xp,u,p:longint;
    a:array[1..100000] of pnod;
    pn,nou:pnod;
    viz:array[0..10001] of boolean;
    c,x:array[1..10001] of longint;

procedure citire;
  var x,y:longint;
  begin
    assign(f,'bfs.in');
    reset(f);
    readln(f,n,m,xp);
    for i:=1 to m do begin
      readln(f,x,y);
      pn:=a[x];
      if pn<>nil then
      while pn^.adr<>nil do
        pn:=pn^.adr;
      new(nou);
      nou^.inf:=y;
      if pn=nil then a[x]:=nou else pn^.adr:=nou;
    end;
    assign(g,'bfs.out');
    rewrite(g);
  end;

procedure bfs;
  begin
    c[1]:=xp;
    viz[xp]:=true;
    u:=1;
    p:=1;
    for p:=1 to n do begin
      pn:=a[p];
      if pn<>nil then while pn<>nil do begin
        if (viz[pn^.inf]=false) then begin
          viz[pn^.inf]:=true;
          x[pn^.inf]:=x[p]+1;
        end; pn:=pn^.adr; end;
    end;
  end;

procedure afisare;
  begin
    for i:=1 to n do if (i<>xp) and (x[i]=0) then
     write(g,-1,' ') else write(g,x[i],' ');
    close(g);
  end;

begin
  citire;
  bfs;
  afisare;
end.