Cod sursa(job #449234)

Utilizator ati90atiNagy Attila ati90ati Data 5 mai 2010 22:36:16
Problema BFS - Parcurgere in latime Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.13 kb
Program szelteben;
Var A:array[1..2,1..15000] of longint;
    cs,szint,helyek:array[1..15000] 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
      begin
        r:=false;
        for seged:=1 to m do
          if (a[1,seged]=k) and (a[2,seged]=j) then
            r:=true;
        If r and (l[j]=0) then
        begin
          u:=u+1;
          cs[u]:=j;
          l[j]:=1;
          szint[u]:=szint[e]+1;
        end;
      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,a[1,i],a[2,i]);
  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.