Cod sursa(job #616933)

Utilizator chimistuFMI Stirb Andrei chimistu Data 13 octombrie 2011 18:11:23
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.37 kb
type matrice=array[1..20,1..20] of integer;
var a:matrice;
i,j,n,m,s,x1,x2:integer;
f:text;
w:array[1..100] of integer;
v:array[1..100] of integer;
procedure parcurgere;
var viz:array[1..20] of 0..1;
c:array[1..20] of integer;
pi,pf,k,j:integer;
da:boolean;
begin
        k:=1;
        for i:=1 to n do
                viz[i]:=0;
        pi:=1;pf:=1;
        viz[s]:=1; w[s]:=0;c[pi]:=s;
        da:=true;
        while pi<=pf do begin
                for i:=1 to n do
                        if (viz[i]=0) and (a[c[pi],i]=1 )then begin
                                pf:=pf+1;
                                c[pf]:=i;
                                viz[i]:=1;da:=false;
                                w[i]:=k;end;
                if da=false then begin
                        k:=k+1;da:=true;end;
                pi:=pi+1;
        end;
end;
begin
        assign (f,'BFs.in');assign (g,'bfs.out');rewrite(g);
        reset(f);
        read (f,n,m,s);
        for i:=1 to m do begin
                read(f,x1,x2);
                a[x1,x2]:=1;end;
        for i:=1 to n do
                w[i]:=-1;
        parcurgere;  w[s]:=0;
        for i:=1 to n do                   begin
                for j:=1 to n do
                        write (a[i,j],' '); writeln;    end;
        for i:=1 to n do
                write (g,w[i],' ');
        close(g);
end.