Cod sursa(job #590658)

Utilizator RainDropsMDMinzelevschi Igori RainDropsMD Data 19 mai 2011 08:48:36
Problema Sortare topologica Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.86 kb
type vector=array[1..100000]of longint;
var buf:array[1..100000]of char;
    x,y,a,p:vector;
    n,m:longint;

procedure Scoate;
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 p[i]:=i;
 close(f);
end;

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

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

procedure sortare;
var i,k: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 swap(p[x[i]],p[y[i]]);  b:=true; end;
   k:=i;
  end;
end;


begin
 Scoate;
 Sortare;
 Scrie;
end.