Cod sursa(job #448928)

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

function hossz(kezdetiCsp:integer; vegsoCsp:integer):integer;
var i,max:integer;
    r:boolean;
    var l:array[1..2500] of 0..1;
begin
  For i:=1 to n do
    l[i]:=0;
  max:=0;
  i:=kezdetiCsp;
  cs[1]:=i;
  e:=1;
  u:=1;
  r:=false;
  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;
          if not r then
          begin
            max:=max+1;
            r:=true;
          end;
          if j=vegsoCsp then
          begin
            hossz:=max;
            exit;
          end;
        end;
    r:=false;
    e:=e+1;end;
  hossz:=-1;
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);

  for i:=1 to n do
  begin
    if i=s then
      write(t2,'0 ')
    else
      write(t2,hossz(S,i),' ');
  end;
  close(t2);
End.