Cod sursa(job #1037870)

Utilizator vyrtusRadu Criuleni vyrtus Data 20 noiembrie 2013 20:20:34
Problema BFS - Parcurgere in latime Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.39 kb
Program cautarea_afisarea_celui_mai_scurt_drum_in_graf;

 type graf=record
          x,y:integer;
           end;
      rezultate=record
       x,k:integer;
          end;

var i,n,m,s,l,r:integer;     g:text;
        drum:array[1..1000000] of graf;
        rez:array[1..100001] of rezultate;
        parcurs:array[1..100001] of boolean;
        val:array[1..100001] of longint;

    Procedure readfile;
     var f:text;
      begin
       assign(f,'bfs.in'); reset(f);
        readln(f,n,m,s);
        for i:=1 to m do
           readln(f,drum[i].x,drum[i].y);
        close(f);
     end;





    begin

      readfile;
          for i:=1 to n do
          parcurs[i]:=true;

       l:=1; r:=2;
         rez[l].x:=s; rez[l].k:=0; parcurs[s]:=false; val[s]:=0;
       while (l<r) do
        begin
          for i:=1 to m do
            if (drum[i].x=rez[l].x) and (parcurs[drum[i].y]) then
                     begin
                      val[drum[i].y]:=rez[l].k+1;
                      parcurs[drum[i].y]:=false;
                      rez[r].x:=drum[i].y;
                      rez[r].k:=rez[l].k+1;
                      inc(r);
                     end;
          inc(l);
        end;

     assign(g,'bfs.out');
      rewrite(g);
    for i:=1 to n do
      if (val[i]=0) and (i<>s) then write(g,'-1 ') else
        write(g,val[i],' ');
      close(g);

    end.