Cod sursa(job #601408)

Utilizator vendettaSalajan Razvan vendetta Data 6 iulie 2011 14:46:08
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 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 add( var dest : pnod; val : longint );
    var
        q : pnod;
    begin
        new( q );
        q^.info := val;
        q^.next := dest;
        dest := q;
    end;

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] := 1;

        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);
        add( a[x], y );
        add( a[y], x );
    end;

    bfs( start );

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

end.