Cod sursa(job #1585246)

Utilizator iondodon1998Dodon Ion iondodon1998 Data 30 ianuarie 2016 21:21:49
Problema Sortare topologica Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.5 kb
Program TopoSort;
type lista=^datelista;
			celula=^datecelula;
			datelista=record
				nr:integer;
				next:lista;
			end;
			datecelula=record
				a,x,z:lista;
			end;
			tabel=array[1..50000] of celula;
			tabelp=array[1..50000] of boolean;
			solutie=array[1..50000] of integer;
var t:tabel;
		p:tabelp;
		sol:solutie;
		n,m,l:longint;
		f1,f2:text;

Procedure initgraf;
	var i:integer;
	begin
		for i:=1 to n do 
			begin
				new(t[i]);
				new(t[i]^.x);
				t[i]^.x^.nr:=-1;
				t[i]^.x^.next:=nil;
				t[i]^.a:=t[i]^.x;
				t[i]^.z:=t[i]^.x;
			end;
	end;

Procedure readdata;
	var i,a,b:longint;
	begin
		for i:=1 to m do 
			begin
				readln(f1,a,b);
				new(t[a]^.x);
				t[a]^.x^.nr:=b;
				t[a]^.x^.next:=nil;
				t[a]^.z^.next:=t[a]^.x;
				t[a]^.z:=t[a]^.x;
			end;
	end;

Procedure visit(i:integer);
	begin
		p[i]:=true;
		t[i]^.x:=t[i]^.a^.next;
		while (t[i]^.x<>nil) do 
			begin
				if p[t[i]^.x^.nr]=false then
					visit(t[i]^.x^.nr);
				t[i]^.x:=t[i]^.x^.next;
			end;
		l:=l+1;
		sol[l]:=i;
	end;

Procedure TopoSort;
	var i:integer;
	begin
		l:=0;
		for i:=1 to n do 
			if p[i]=false then
				visit(i);
	end;

Procedure result;
	var i:integer;
	begin
		for i:=l downto 1 do 
			write(f2,sol[i],' ');
	end;


Procedure main;
	begin
		readln(f1,n,m);
		initgraf;
		readdata;
		toposort;
		result;
	end;

begin
	assign(f1,'sortare.in'); reset(f1);
	assign(f2,'sortare.out'); rewrite(f2);
	main;
	close(f1);
	close(f2);
end.