Cod sursa(job #449237)

Utilizator ati90atiNagy Attila ati90ati Data 5 mai 2010 22:47:53
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.01 kb
Program szelteben;
Var A:array[1..10000,1..10000] of longint;
    cs,szint,helyek:array[1..10000] of integer;
    m,n,i,j,k,e,u,S:longint;
    t1,t2:text;

procedure bejarBFS(kezdetiCsp:integer);
var i,seged:longint;
    r:boolean;
    l:array[1..250] of 0..1;
begin
  for seged:=1 to n do
    l[seged]:=0;
  i:=kezdetiCsp;
  cs[1]:=i;
  szint[1]:=0;
  e:=1;
  u:=1;
  l[i]:=1;
  While e<=n do
  begin
    k:=cs[e];
    For j:=1 to n do
      if k<>j then
        If (a[k,j]=1) and (l[j]=0) then
        begin
          u:=u+1;
          cs[u]:=j;
          l[j]:=1;
          szint[u]:=szint[e]+1;
        end;
    e:=e+1;end;
end;

Begin
  assign(t1,'bfs.in');reset(t1);
  readln(t1,n,m,S);
  For i:=1 to m do
  begin
    readln(t1,x1,x2);
  a[x1,x2]:=1;
  end;
  close(t1);
  assign(t2,'bfs.out');rewrite(t2);
  bejarBFS(S);
  for i:=1 to n do
    helyek[i]:=-1;
  for i:=1 to u do
    helyek[cs[i]]:=szint[i];
  for i:=1 to n do
    write(t2,helyek[i],' ');
  close(t2);
End.