Cod sursa(job #271377)

Utilizator philipPhilip philip Data 5 martie 2009 11:03:05
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.2 kb
type pnod=^nod;
     nod=record
       inf:longint;
       adr:pnod;
     end;

var f,g:text;
    n,m,i,xp,p,u:longint;
    a,ult:array[1..100000] of pnod;
    pn,nou:pnod;
    viz:array[0..100001] of boolean;
    x,s:array[1..100001] 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);
      new(nou);
      nou^.inf:=y;
      if a[x]=nil then begin a[x]:=nou; ult[x]:=a[x]; end
      else begin ult[x]^.adr:=nou; ult[x]:=nou; end;
    end;
    assign(g,'bfs.out');
    rewrite(g);
  end;

procedure bfs;
  begin
    viz[xp]:=true;
    s[1]:=xp;
    p:=1;
    u:=1;
    while p<=u do begin
      pn:=a[s[p]];
      if pn<>nil then while pn<>nil do begin
        if (viz[pn^.inf]=false) then begin
          inc(u);
          s[u]:=pn^.inf;
          viz[pn^.inf]:=true;
          x[pn^.inf]:=x[s[p]]+1;
        end; pn:=pn^.adr; end;
      p:=p+1;
    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.