Cod sursa(job #1339732)

Utilizator George97George Linut George97 Data 11 februarie 2015 08:40:06
Problema BFS - Parcurgere in latime Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.73 kb

 type element=record
     i,j:longint;
     end;
var a,cc:array[1..1000001] of element;
    f:text;
    l1,l2:array[0..100001] of longint;
    p,i,j,n,m,s,k:longint;
    viz,b,c:array[1..100001]of longint;
    x,y:longint;

procedure ordon(i,j:longint);
var mijl,k,l,p,p1:longint;
begin
if i=j then
       else
begin
mijl:=(i+j) div 2;
ordon(i,mijl);
ordon(mijl+1,j);
l:=i-1;
k:=i;
p:=mijl+1;
repeat
if a[k].i>a[p].i then
  begin
  inc(l);
  cc[l]:=a[p];
  inc(p);
  end
                 else
  begin
  inc(l);
  cc[l]:=a[k];
  inc(k);
  end;
until (k>mijl) or (p>j);
if k>mijl then
  for k:=p to j do
    begin
    inc(l);
    cc[l]:=a[k];
    end
          else
  for p:=k to mijl do
    begin
    inc(l);
    cc[l]:=a[p];
    end;
  for k:=i to j do
    a[k]:=cc[k];
  end;
end;
begin
 assign(f,'bfs.in');reset(f);
 readln(f,n,m,s);

 for i:=1 to m do
 begin
    read(f,x,y);
    a[i].i:=x;
    a[i].j:=y;
 end;
ordon(1,m);
 for i:=1 to n do viz[i]:=-1;
 close(f);
i:=1;
p:=1;
b[1]:=s;
c[1]:=0;
viz[s]:=0;
l1[0]:=0;l2[0]:=0;
k:=0;
for i:=1 to n do
begin
inc(k);
if a[k].i>i then l1[i]:=-1
            else
 begin
 l1[i]:=k;
 while a[k+1].i=i do inc(k);
 l2[i]:=k;
 end;
end;
i:=1;
p:=1;
while i<=p do
  begin
    x:=b[i];
    if l1[x]<>-1 then
    begin
    for j:=l1[x] to l2[x] do
      if (viz[a[j].j]=-1)  then
       begin
         inc(p);
         b[p]:=a[j].j;
         c[p]:=c[i]+1;
         viz[a[j].j]:=c[p];
       end;
    end;
     inc(i);
    end;

assign(f,'bfs.out');
rewrite(f);
for i:=1 to n do write(f,viz[i],' ');
close(f);
end.