Cod sursa(job #271319)

Utilizator philipPhilip philip Data 5 martie 2009 09:30:36
Problema BFS - Parcurgere in latime Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
var f,g:text;
    n,m,i,j,xp,u,p:longint;
    a:array[0..100000,1..100000] of boolean;
    viz:array[0..100001] of boolean;
    c,x:array[1..100001] of longint;

procedure citire;
  var x,y:longint;
  begin
    assign(f,'bfs.in');
    reset(f);
    readln(f,n,m,xp);
    for i:=1 to m do begin
      readln(f,x,y);
      a[x,y]:=true;
      a[y,x]:=true;
    end;
    assign(g,'bfs.out');
    rewrite(g);
  end;

procedure bfs;
  begin
    c[1]:=xp;
    viz[xp]:=true;
    u:=1;
    p:=1;
    while p<=u do begin
      for i:=1 to n do
        if (a[p,i]=true) and (viz[i]=false) then begin
          inc(u);
          c[u]:=i;
          viz[i]:=true;
          x[u]:=p;
        end;
        inc(p);
    end;
  end;

procedure afisare;
  begin
    for i:=1 to n do write(g,x[i],' ');
    close(g);
  end;

begin
  citire;
  bfs;
  afisare;
end.