Cod sursa(job #590912)

Utilizator vendettaSalajan Razvan vendetta Data 21 mai 2011 11:34:23
Problema BFS - Parcurgere in latime Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.28 kb
const f = 'bfs.in'; g = 'bfs.out';

type pnod = ^nod;
     nod = record
        next : pnod;
        info : longint;
end;

var
    a : array[0..100001] of pnod;
    S, cost : array[0..100001] of longint;
    x, y, start, m, n : longint;
    i : longint;
    p : pnod;
    buf, buf1 : array[1..1 shl 17] of char;
procedure bfs( start : longint );
    var
        st, dr : longint;
    begin
        for i := 1 to n do cost[i] := -1;

        st := 0; dr := 1;
        S[st] := start;
        cost[start] := 0;

        while (st <= dr) do begin
            p := a[S[st]];
            while p <> nil do begin
                if (cost[p^.info] = -1) then begin
                    inc( dr );
                    S[dr] := p^.info;
                    cost[p^.info] := cost[S[st]] + 1;
                end;
                p := p^.next;
            end;
            inc( st );
        end;

    end;

begin
    assign( input,f ); reset( input );
    assign( output,g ); rewrite( output );
    settextbuf( input,buf );
    settextbuf( output,buf1 );
    readln(n, m, start );
    for i:=1 to m do begin
        readln(x, y);
        new( p );
        p^.next:=a[x]; p^.info:=y; a[x]:=p;
    end;

    bfs( start );

    for i:=1 to n do write(cost[i],' ');

end.