Cod sursa(job #449226)

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

procedure bejarBFS(kezdetiCsp:integer);
var i:integer;
    l:array[1..250] of 0..1;
begin
  for i:=1 to n do
    l[i]:=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 n do
    For j:=1 to n do
      A[i,j]:=0;
  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.