Cod sursa(job #681468)
Utilizator | Data | 17 februarie 2012 09:18:11 | |
---|---|---|---|
Problema | Sortare prin comparare | Scor | 0 |
Compilator | fpc | Status | done |
Runda | Arhiva educationala | Marime | 3.12 kb |
var a:array[0..100] of integer;
ok:boolean;
f,g:text;
t,i,n,aux,p:integer;
begin
assign(f,'algsort.in'); reset (f);
assign(g,'algsort.out'); rewrite (g);
readln (f,n);
a[0]:=-maxint;
for i:=1 to n do
begin read (f,a[i]);
if (a[i div 2]>a[i]) then begin aux:=a[i div 2];
a[i div 2]:=a[i];
a[i]:=aux;
t:=i div 2;
ok:=false;
while (t<>1) and (ok=false) do
begin if (a[t]>=a[t div 2]) then ok:=true;
if (a[t]<a[t div 2]) then begin aux:=a[t div 2];
a[t div 2]:=a[t];
a[t]:=aux;
t:=t div 2;
end;
end;
end;
end;
while n<>2 do
begin aux:=a[1];
a[1]:=a[n];
a[n]:=aux;
write (g,a[n],' ');
a[n]:=0;
n:=n-1;
if (a[2]<a[1]) and (a[2]<=a[3]) then begin aux:=a[2];
a[2]:=a[1];
a[1]:=aux;
p:=2;
end;
if (a[3]<a[1]) and (a[2]>a[3]) then begin aux:=a[3];
a[3]:=a[1];
a[1]:=aux;
p:=3;
end;
if (p*2<=n) then for i:=p to n do
begin
if (a[i div 2]>a[i]) then begin aux:=a[i div 2];
a[i div 2]:=a[i];
a[i]:=aux;
t:=i div 2;
ok:=false;
while (t<>0) and (ok=false) do
begin if (a[t]>=a[t div 2]) then ok:=true;
if (a[t]<a[t div 2]) then begin aux:=a[t div 2];
a[t div 2]:=a[t];
a[t]:=aux;
t:=t div 2;
end;
end;
end;
end;
end;
if a[2]<a[3] then write (g,a[2],' ',a[3]);
if a[2]>a[3] then write (g,a[3],' ',a[2]);
close (f);
close (g);
end.