Cod sursa(job #579284)

Utilizator gicu_01porcescu gicu gicu_01 Data 12 aprilie 2011 00:03:36
Problema Sortare topologica Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
type vector=array[1..100000]of longint;
var buf:array[1..100000]of char;
    x,y,a,p:vector;
    n,m:longint;

procedure citire;
var i:longint; f:text;
begin
 assign(f,'sortaret.in');
 reset(f);
 settextbuf(f,buf);
 readln(f,n,m);
 for i:=1 to m do readln(f,x[i],y[i]);
 for i:=1 to n do begin a[i]:=i; p[i]:=i;end;
 close(f);
end;

procedure afis;
var i:longint;f:text;
begin
 assign(f,'sortaret.out');
 rewrite(f);
 settextbuf(f,buf);
 for i:=1 to n do write(f,a[i],' ');
 close(f);
end;

procedure sw(var a,b:longint);
var t:longint;
begin
 t:=a;a:=b;b:=t;
end;

procedure sortaret;
var i:longint; b:boolean;
begin
 b:=true;
 while b do
  begin
   b:=false;
   for i:=1 to m do
    if p[x[i]]>p[y[i]] then begin sw(a[p[x[i]]],a[p[y[i]]]);sw(p[x[i]],p[y[i]]);  b:=true; break; end;
  end;
end;


begin
 citire;
 sortaret;
 afis;
end.