全国青少年信息学奥林匹克竞赛培训---堆排序

var
  a:array[1..10] of integer
  =(4,3,5,1,10,2,6,9,7,8);

procedure Print;
var c:integer;
begin
  for c:=1 to 10 do
  begin
    write(a[c]:5);
  end;
  writeln;
end;


procedure adjust(i,n:integer); {max heap}
var temp:integer;
begin
  while i*2<=n do
  begin
  //Print;
  i:=i*2;{i-->left child}
  if (i<n) and (a[i]<a[i+1]) then inc(i);
  if a[i]>a[i div 2] then
  begin
    temp:=a[i];
    a[i]:=a[i div 2];
    a[i div 2]:=temp;
  end
  else break;
  end;
end;

var i,temp:integer;

begin
   Print;
   for i:=10 div 2 downto 1 do
   adjust(i,10);{init}
   Print;

   for i:=1 to 9 do
   begin
        temp:=a[1];
        a[1]:=a[10-i+1];
        a[10-i+1]:=temp;
        adjust(1,10-i);
   Print;
   end;

   readln;
end.