Cod sursa(job #717281)

Utilizator MihaiBunBunget Mihai MihaiBun Data 19 martie 2012 19:48:29
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.56 kb
program kk;
type ref=^inr;
     inr=record
            nr:longint;
            adr:ref
         end;
var f:text;
    i,n,m,s,x,y:longint;
    nod:array[1..100000] of ref;
    pc,uc,q,w:ref;
    viz:array[1..100000] of 0..1;
    cost:array[1..100000] of longint;
begin
  assign(f,'bfs.in');
  reset(f);
  readln(f,n,m,s);
  for i:=1 to m do
    begin
      readln(f,x,y);
      new(q);
      q^.adr:=nil;
      q^.nr:=y;
      if nod[x]=nil then nod[x]:=q
                    else begin
                           q^.adr:=nod[x];
                           nod[x]:=q;
                          end;
    end;
  new(pc);
  pc^.nr:=s;
  pc^.adr:=nil;
  uc:=pc;
  viz[s]:=1;
  cost[s]:=0;
  while pc<>nil do
    begin
      x:=pc^.nr;
      q:=nod[x];
      while q<>nil do
        begin
          y:=q^.nr;
          if viz[q^.nr]=0 then begin
                                 cost[y]:=cost[x]+1;
                                 viz[y]:=1;
                                 new(w);
                                 w^.nr:=y;
                                 w^.adr:=nil;
                                 uc^.adr:=w;
                                 uc:=w;
                               end;
           q:=q^.adr;
        end;
      q:=pc;
      pc:=pc^.adr;
      dispose(q);
    end;
  close(f);
  assign(f,'bfs.out');
  rewrite(f);
  for i:=1 to n do if cost[i]<>0 then write(f,cost[i],' ')
                                 else if i=s then write(f,0,' ')
                                             else write(f,-1,' ');
  close(f);
end.