Cod sursa(job #686994)

Utilizator iu.ciocoiuIulian iu.ciocoiu Data 21 februarie 2012 23:53:57
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.24 kb
program sort_opt;
var v:array [0..500001] of longint;
    aux:longint;
    i, j, n, an, min:longint;
    f, g:text;
begin
assign (f,'algsort.in'); reset (f);
assign (g,'algsort.out'); rewrite (g);
read (f,n);
for i:=1 to n do
   begin read (f,v[i]);
         j:=i;
         while (v[j]<v[j div 2]) do
            begin aux:= v[j];
  			      v[j]:=v[j div 2]; 
				  v[j div 2]:=aux;
                  j:=j div 2;
            end;
   end;
an:=n;
for i:=1 to n do
   begin write (g,v[1],' ');
         v[1]:=v[an];
         an:=an-1;
         j:=1;
         min:=1;
         while (min<>0) do
            begin min:=0;
                  if (j*2<=an) then begin min:=j*2;
                                          if (j*2+1<=an) and (v[j*2+1]<v[j*2]) then min:=j*2+1;
                                          if (v[min]>v[j]) then min:=0;
                                          if (min<>0) then begin aux:=v[j]; 
										                         v[j]:=v[min]; 
																 v[min]:=aux; 
                                                                 j:=min;
                                                           end;
                                    end;
            end;
   end;
close (f); 
close (g);
end.