Cod sursa(job #587028)

Utilizator blustudioPaul Herman blustudio Data 3 mai 2011 19:51:35
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.11 kb
program heapsort;
var fin, fout :text;
	v :array [1..500000] of longint;
	i, n :longint;
	mleft, mright, largest, he, temp, hs :longint;
	buffin, buffout :array [1..65000] of byte;
	
procedure heapify();
begin
	mleft := he*2;
	mright := mleft+1;
	if (mleft <= hs) and (v[mleft] > v[he]) then
		largest := mleft
	else
		largest := he;
	if (mright <= hs) and (v[mright] > v[largest]) then
		largest := mright;
	if (he <> largest) then
	begin
		temp := v[he];
		v[he] := v[largest];
		v[largest] := temp;
		he := largest;
		heapify();
	end;
end;

procedure sortheap();
begin
	hs := n;
	for i:=(n div 2) downto 1 do
	begin
		he := i;
		heapify();
	end;
	for i:=n downto 2 do
	begin
		temp := v[1];
		v[1] := v[i];
		v[i] := temp;
		hs := hs-1;
		he := 1;
		heapify();
	end;
	exit;
end;

begin
	assign(fin, 'algsort.in');
	assign(fout, 'algsort.out');
	reset(fin);
	rewrite(fout);
	settextbuf(fin, buffin);
	settextbuf(fout, buffout);
	readln(fin, n);
	for i:=1 to n do
		read(fin, v[i]);
	sortheap();
	for i:=1 to n do
		write(fout, v[i], ' ');
	close(fin);
	close(fout);
end.